- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/T26217
by Teo Camarasu (＠teo) 17 Aug '25

17 Aug '25

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

1 0

[Git][ghc/ghc][wip/9.10.3-backports] 4 commits: rts: ensure MessageBlackHole.link is always a valid closure
by Zubin (＠wz1000) 17 Aug '25

17 Aug '25

Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC Commits: dea3e5d6 by Teo Camarasu at 2025-08-17T22:31:50+05:30 rts: ensure MessageBlackHole.link is always a valid closure We turn a MessageBlackHole into an StgInd in wakeBlockingQueue(). Therefore it's important that the link field, which becomes the indirection field, always points to a valid closure. It's unclear whether it's currently possible for the previous behaviour to lead to a crash, but it's good to be consistent about this invariant nonetheless. Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at> (cherry picked from commit a8b2fbae6bcf20bc2f3fe58803096d2a9c5fc43d) - - - - - 97299e94 by Teo Camarasu at 2025-08-17T22:31:57+05:30 rts: spin if we see a WHITEHOLE in messageBlackHole When a BLACKHOLE gets cancelled in raiseAsync, we indirect to a THUNK. GC can then shortcut this, replacing our BLACKHOLE with a fresh THUNK. This THUNK is not guaranteed to have a valid indirectee field. If at the same time, a message intended for the previous BLACKHOLE is processed and concurrently we BLACKHOLE the THUNK, thus temporarily turning it into a WHITEHOLE, we can get a segfault, since we look at the undefined indirectee field of the THUNK The fix is simple: spin if we see a WHITEHOLE, and it will soon be replaced with a valid BLACKHOLE. Resolves #26205 (cherry picked from commit 4021181ee0860aca2054883a531f3312361cc701) - - - - - 2e47cd55 by Reed Mullanix at 2025-08-17T22:33:53+05:30 ghc-internal: Fix naturalAndNot for NB/NS case When the first argument to `naturalAndNot` is larger than a `Word` and the second is `Word`-sized, `naturalAndNot` will truncate the result: ``` >>> naturalAndNot ((2 ^ 65) .|. (2 ^ 3)) (2 ^ 3) 0 ``` In contrast, `naturalAndNot` does not truncate when both arguments are larger than a `Word`, so this appears to be a bug. Luckily, the fix is pretty easy: we just need to call `bigNatAndNotWord#` instead of truncating. Fixes #26230 (cherry picked from commit a766286fe759251eceb304c54ba52841c2a51f86) - - - - - 1ea64785 by sheaf at 2025-08-17T22:36:18+05:30 RecordCon lookup: don't allow a TyCon This commit adds extra logic when looking up a record constructor. If GHC.Rename.Env.lookupOccRnConstr returns a TyCon (as it may, due to the logic explained in Note [Pattern to type (P2T) conversion]), we emit an error saying that the data constructor is not in scope. This avoids the compiler falling over shortly thereafter, in the call to 'lookupConstructorInfo' inside 'GHC.Rename.Env.lookupRecFieldOcc', because the record constructor would not have been a ConLike. Fixes #25056 (cherry picked from commit da306610b9e58cfb7cf2530ebeec7ee8ad17183a) - - - - - 23 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Utils/Env.hs - libraries/base/changelog.md - libraries/ghc-bignum/changelog.md - libraries/ghc-bignum/src/GHC/Num/Natural.hs - rts/Messages.c - rts/StgMiscClosures.cmm - rts/Updates.h - + testsuite/tests/numeric/should_run/T26230.hs - + testsuite/tests/numeric/should_run/T26230.stdout - testsuite/tests/numeric/should_run/all.T - + testsuite/tests/rename/should_fail/T25056.hs - + testsuite/tests/rename/should_fail/T25056.stderr - + testsuite/tests/rename/should_fail/T25056a.hs - + testsuite/tests/rename/should_fail/T25056b.hs - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_fail/T23739b.hs - testsuite/tests/typecheck/should_fail/T23739b.stderr - + testsuite/tests/typecheck/should_fail/T23739c.hs - + testsuite/tests/typecheck/should_fail/T23739c.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -436,6 +436,7 @@ lookupConstructorInfo con_name ; case info of IAmConLike con_info -> return con_info UnboundGRE -> return ConHasPositionalArgs + IAmTyCon {} -> failIllegalTyCon WL_Constructor con_name _ -> pprPanic "lookupConstructorInfo: not a ConLike" $ vcat [ text "name:" <+> ppr con_name ] } @@ -1029,24 +1030,12 @@ lookupOccRn' which_suggest rdr_name lookupOccRn :: RdrName -> RnM Name lookupOccRn = lookupOccRn' WL_Anything --- lookupOccRnConstr looks up an occurrence of a RdrName and displays --- constructors and pattern synonyms as suggestions if it is not in scope +-- | Look up an occurrence of a 'RdrName'. -- --- There is a fallback to the type level, when the first lookup fails. --- This is required to implement a pat-to-type transformation --- (See Note [Pattern to type (P2T) conversion] in GHC.Tc.Gen.Pat) --- Consider this example: +-- Displays constructors and pattern synonyms as suggestions if +-- it is not in scope. -- --- data VisProxy a where VP :: forall a -> VisProxy a --- --- f :: VisProxy Int -> () --- f (VP Int) = () --- --- Here `Int` is actually a type, but it stays on position where --- we expect a data constructor. --- --- In all other cases we just use this additional lookup for better --- error messaging (See Note [Promotion]). +-- See Note [lookupOccRnConstr] lookupOccRnConstr :: RdrName -> RnM Name lookupOccRnConstr rdr_name = do { mb_gre <- lookupOccRn_maybe rdr_name @@ -1058,6 +1047,28 @@ lookupOccRnConstr rdr_name Just gre -> return $ greName gre Nothing -> reportUnboundName' WL_Constructor rdr_name} } +{- Note [lookupOccRnConstr] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +lookupOccRnConstr looks up a data constructor or pattern synonym. Simple. + +However, there is a fallback to the type level when the lookup fails. +This is required to implement a pat-to-type transformation +(See Note [Pattern to type (P2T) conversion] in GHC.Tc.Gen.Pat) + +Consider this example: + + data VisProxy a where VP :: forall a -> VisProxy a + + f :: VisProxy Int -> () + f (VP Int) = () + +Here `Int` is actually a type, but it occurs in a position in which we expect +a data constructor. + +In all other cases we just use this additional lookup for better +error messaging (See Note [Promotion]). +-} + -- lookupOccRnRecField looks up an occurrence of a RdrName and displays -- record fields as suggestions if it is not in scope lookupOccRnRecField :: RdrName -> RnM Name ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -532,9 +532,9 @@ rnExpr (ExplicitSum _ alt arity expr) = do { (expr', fvs) <- rnLExpr expr ; return (ExplicitSum noExtField alt arity expr', fvs) } -rnExpr (RecordCon { rcon_con = con_id +rnExpr (RecordCon { rcon_con = con_rdr , rcon_flds = rec_binds@(HsRecFields { rec_dotdot = dd }) }) - = do { con_lname@(L _ con_name) <- lookupLocatedOccRnConstr con_id + = do { con_lname@(L _ con_name) <- lookupLocatedOccRnConstr con_rdr ; (flds, fvs) <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds ; (flds', fvss) <- mapAndUnzipM rn_field flds ; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1161,7 +1161,7 @@ tc_infer_id id_name AGlobal (AConLike (RealDataCon con)) -> tcInferDataCon con AGlobal (AConLike (PatSynCon ps)) -> tcInferPatSyn id_name ps - (tcTyThingTyCon_maybe -> Just tc) -> failIllegalTyCon WL_Anything tc -- TyCon or TcTyCon + (tcTyThingTyCon_maybe -> Just tc) -> failIllegalTyCon WL_Anything (tyConName tc) ATyVar name _ -> failIllegalTyVal name _ -> failWithTc $ TcRnExpectedValueId thing } ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -280,7 +280,7 @@ tcLookupConLike name = do thing <- tcLookupGlobal name case thing of AConLike cl -> return cl - ATyCon tc -> failIllegalTyCon WL_Constructor tc + ATyCon {} -> failIllegalTyCon WL_Constructor name _ -> wrongThingErr WrongThingConLike (AGlobal thing) name tcLookupRecSelParent :: HsRecUpdParent GhcRn -> TcM RecSelParent @@ -353,19 +353,20 @@ instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where lookupThing = tcLookupGlobal -- Illegal term-level use of type things -failIllegalTyCon :: WhatLooking -> TyCon -> TcM a +failIllegalTyCon :: WhatLooking -> Name -> TcM a failIllegalTyVal :: Name -> TcM a (failIllegalTyCon, failIllegalTyVal) = (fail_tycon, fail_tyvar) where - fail_tycon what_looking tc = do + fail_tycon what_looking tc_nm = do gre <- getGlobalRdrEnv - let nm = tyConName tc - pprov = case lookupGRE_Name gre nm of + let mb_gre = lookupGRE_Name gre tc_nm + pprov = case mb_gre of Just gre -> nest 2 (pprNameProvenance gre) Nothing -> empty - err | isClassTyCon tc = ClassTE - | otherwise = TyConTE - fail_with_msg what_looking dataName nm pprov err + err = case greInfo <$> mb_gre of + Just (IAmTyCon ClassFlavour) -> ClassTE + _ -> TyConTE + fail_with_msg what_looking dataName tc_nm pprov err fail_tyvar nm = let pprov = nest 2 (text "bound at" <+> ppr (getSrcLoc nm)) ===================================== libraries/base/changelog.md ===================================== @@ -2,6 +2,7 @@ ## 4.20.2 *July 2025* * Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)). + * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350)) ## 4.20.1 *Jan 2025* * Shipped with GHC 9.10.2 ===================================== libraries/ghc-bignum/changelog.md ===================================== @@ -4,6 +4,7 @@ - Expose backendName - Add `naturalSetBit[#]` (#21173), `naturalClearBit[#]` (#21175), `naturalComplementBit[#]` (#21181) +- Fix bug where `naturalAndNot` was incorrectly truncating results (#26230) ## 1.2 ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -488,7 +488,7 @@ naturalAndNot :: Natural -> Natural -> Natural {-# NOINLINE naturalAndNot #-} naturalAndNot (NS n) (NS m) = NS (n `and#` not# m) naturalAndNot (NS n) (NB m) = NS (n `and#` not# (bigNatToWord# m)) -naturalAndNot (NB n) (NS m) = NS (bigNatToWord# n `and#` not# m) +naturalAndNot (NB n) (NS m) = NB (bigNatAndNotWord# n m) naturalAndNot (NB n) (NB m) = naturalFromBigNat# (bigNatAndNot n m) naturalOr :: Natural -> Natural -> Natural ===================================== rts/Messages.c ===================================== @@ -180,13 +180,22 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) bh_info != &stg_CAF_BLACKHOLE_info && bh_info != &__stg_EAGER_BLACKHOLE_info && bh_info != &stg_WHITEHOLE_info) { - // if it is a WHITEHOLE, then a thread is in the process of - // trying to BLACKHOLE it. But we know that it was once a - // BLACKHOLE, so there is at least a valid pointer in the - // payload, so we can carry on. return 0; } + // If we see a WHITEHOLE then we should wait for it to turn into a BLACKHOLE. + // Otherwise we might look at the indirectee and segfault. + // See "Exception handling" in Note [Thunks, blackholes, and indirections] + // We might be looking at a *fresh* THUNK being WHITEHOLE-d so we can't + // guarantee that the indirectee is a valid pointer. +#if defined(THREADED_RTS) + if (bh_info == &stg_WHITEHOLE_info) { + while(ACQUIRE_LOAD(&bh->header.info) == &stg_WHITEHOLE_info) { + busy_wait_nop(); + } + } +#endif + // The blackhole must indirect to a TSO, a BLOCKING_QUEUE, an IND, // or a value. StgClosure *p; ===================================== rts/StgMiscClosures.cmm ===================================== @@ -31,6 +31,7 @@ import CLOSURE ENT_VIA_NODE_ctr; import CLOSURE RtsFlags; import CLOSURE stg_BLOCKING_QUEUE_CLEAN_info; import CLOSURE stg_BLOCKING_QUEUE_DIRTY_info; +import CLOSURE stg_END_TSO_QUEUE_closure; import CLOSURE stg_IND_info; import CLOSURE stg_MSG_BLACKHOLE_info; import CLOSURE stg_TSO_info; @@ -597,6 +598,9 @@ retry: MessageBlackHole_tso(msg) = CurrentTSO; MessageBlackHole_bh(msg) = node; + // Ensure that the link field is a valid closure, + // since we might turn this into an indirection in wakeBlockingQueue() + MessageBlackHole_link(msg) = stg_END_TSO_QUEUE_closure; SET_HDR(msg, stg_MSG_BLACKHOLE_info, CCS_SYSTEM); // messageBlackHole has appropriate memory barriers when this object is exposed. // See Note [Heap memory barriers]. ===================================== rts/Updates.h ===================================== @@ -333,6 +333,10 @@ * `AP_STACK` closure recording the aborted execution state. * See `RaiseAsync.c:raiseAsync` for details. * + * This can combine with indirection shortcutting during GC to replace a BLACKHOLE + * with a fresh THUNK. We should be very careful here since the THUNK will have an + * undefined value in the indirectee field. Looking at the indirectee field can then + * lead to a segfault such as #26205. * * CAFs * ---- ===================================== testsuite/tests/numeric/should_run/T26230.hs ===================================== @@ -0,0 +1,8 @@ +import Data.Bits +import GHC.Num.Natural + +main = do + print $ naturalAndNot ((2 ^ 4) .|. (2 ^ 3)) (2 ^ 3) + print $ naturalAndNot ((2 ^ 129) .|. (2 ^ 65)) (2 ^ 65) + print $ naturalAndNot ((2 ^ 4) .|. (2 ^ 3)) ((2 ^ 65) .|. (2 ^ 3)) + print $ naturalAndNot ((2 ^ 65) .|. (2 ^ 3)) (2 ^ 3) ===================================== testsuite/tests/numeric/should_run/T26230.stdout ===================================== @@ -0,0 +1,4 @@ +16 +680564733841876926926749214863536422912 +16 +36893488147419103232 ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -83,3 +83,4 @@ test('T22282', normal, compile_and_run, ['']) test('T22671', js_fragile(24259), compile_and_run, ['']) test('foundation', [when(js_arch(), run_timeout_multiplier(2)), js_fragile(24259)], compile_and_run, ['-O -package transformers']) test('T24066', normal, compile_and_run, ['']) +test('T26230', normal, compile_and_run, ['']) ===================================== testsuite/tests/rename/should_fail/T25056.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE RecordWildCards #-} +module T25056 where + +import T25056b + +foo :: T -> () +foo (T { unT = x }) = x ===================================== testsuite/tests/rename/should_fail/T25056.stderr ===================================== @@ -0,0 +1,5 @@ +T25056.hs:7:10: error: [GHC-01928] + • Illegal term-level use of the type constructor ‘T’ + • imported from ‘T25056b’ at T25056.hs:4:1-14 + (and originally defined in ‘T25056a’ at T25056a.hs:8:1-14) + ===================================== testsuite/tests/rename/should_fail/T25056a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE PatternSynonyms #-} +module T25056a + ( T + , T_(unT) + , pattern T + ) where + +type T = T_ () + +data T_ a = PrivateT { unT_ :: a } + +pattern T :: a -> T_ a +pattern T { unT } <- PrivateT { unT_ = unT } ===================================== testsuite/tests/rename/should_fail/T25056b.hs ===================================== @@ -0,0 +1,3 @@ +module T25056b (T, T_(..)) where + +import T25056a (T, T_(..)) ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -222,6 +222,7 @@ test('T23740g', normal, compile_fail, ['']) test('T23740h', normal, compile_fail, ['']) test('T23740i', req_th, compile_fail, ['']) test('T23740j', normal, compile_fail, ['']) +test('T25056', [extra_files(['T25056a.hs', 'T25056b.hs'])], multimod_compile_fail, ['T25056', '-v0']) test('T23570', [extra_files(['T23570_aux.hs'])], multimod_compile_fail, ['T23570', '-v0']) test('T23570b', [extra_files(['T23570_aux.hs'])], multimod_compile, ['T23570b', '-v0']) test('T17594b', req_th, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T23739b.hs ===================================== @@ -8,7 +8,4 @@ g1 :: Int -> Unit g1 Int = () g2 :: Int -g2 = Int{} - -g3 :: Int -g3 = Int +g2 = Int ===================================== testsuite/tests/typecheck/should_fail/T23739b.stderr ===================================== @@ -6,16 +6,9 @@ T23739b.hs:8:4: error: [GHC-01928] In an equation for ‘g1’: g1 Int = () T23739b.hs:11:6: error: [GHC-01928] - • Illegal term-level use of the type constructor ‘Int’ - • imported from ‘Prelude’ at T23739b.hs:2:8-14 - (and originally defined in ‘GHC.Types’) - • In the expression: Int {} - In an equation for ‘g2’: g2 = Int {} - -T23739b.hs:14:6: error: [GHC-01928] • Illegal term-level use of the type constructor ‘Int’ • imported from ‘Prelude’ at T23739b.hs:2:8-14 (and originally defined in ‘GHC.Types’) • In the expression: Int - In an equation for ‘g3’: g3 = Int + In an equation for ‘g2’: g2 = Int ===================================== testsuite/tests/typecheck/should_fail/T23739c.hs ===================================== @@ -0,0 +1,8 @@ + +module T23739c where + +import Data.Tuple.Experimental +import GHC.TypeLits + +g :: Int +g = Int{} ===================================== testsuite/tests/typecheck/should_fail/T23739c.stderr ===================================== @@ -0,0 +1,7 @@ +T23739c.hs:8:5: error: [GHC-01928] + • Illegal term-level use of the type constructor ‘Int’ + • imported from ‘Prelude’ at T23739c.hs:2:8-14 + (and originally defined in ‘GHC.Types’) + • In the expression: Int {} + In an equation for ‘g’: g = Int {} + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -730,3 +730,4 @@ test('T23739b', normal, compile_fail, ['']) test('T25325', normal, compile_fail, ['']) test('T25004', normal, compile_fail, ['']) test('T25004k', normal, compile_fail, ['']) +test('T23739c', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7d323b0fb0805f3ebc10c91a9d858… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7d323b0fb0805f3ebc10c91a9d858… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/backports-9.14
by Ben Gamari (＠bgamari) 17 Aug '25

17 Aug '25

Ben Gamari pushed new branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.14 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/unreg-run-opt
by Cheng Shao (＠TerrorJack) 17 Aug '25

17 Aug '25

Cheng Shao pushed new branch wip/unreg-run-opt at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/unreg-run-opt You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/python-version-check
by Cheng Shao (＠TerrorJack) 17 Aug '25

17 Aug '25

Cheng Shao pushed new branch wip/python-version-check at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/python-version-check You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/warning-for-last-and-init] Revert submodules
by Bodigrim (＠Bodigrim) 16 Aug '25

16 Aug '25

Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC Commits: add564b6 by Andrew Lelechenko at 2025-08-16T23:24:44+01:00 Revert submodules - - - - - 3 changed files: - hadrian/src/Settings/Warnings.hs - utils/hpc - utils/hsc2hs Changes: ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -78,6 +78,9 @@ ghcWarningsArgs = do ] , package filepath ? pure [ "-Wno-x-partial" ] + , package hpc ? pure [ "-Wno-x-partial" ] + , package hpcBin ? pure [ "-Wno-x-partial" ] + , package hsc2hs ? pure [ "-Wno-x-partial" ] , package cabal ? pure [ "-Wno-deriving-typeable", "-Wno-incomplete-record-selectors" ] -- The -Wno-incomplete-record-selectors is due to ===================================== utils/hpc ===================================== @@ -1 +1 @@ -Subproject commit dd43f7e139d7a4f4908d1e8af35a75939f763ef1 +Subproject commit 5923da3fe77993b7afc15b5163cffcaa7da6ecf5 ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 2059c961fc28bbfd0cafdbef96d5d21f1d911b53 +Subproject commit fe3990b9f35000427b016a79330d9f195587cad8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/add564b60f5e9afb8d6ff625558e5b6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/add564b60f5e9afb8d6ff625558e5b6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23162-spj] 2 commits: Improved error messages from fundep changes
by Simon Peyton Jones (＠simonpj) 16 Aug '25

16 Aug '25

Simon Peyton Jones pushed to branch wip/T23162-spj at Glasgow Haskell Compiler / GHC Commits: 8e2a2e57 by Simon Peyton Jones at 2025-08-16T09:51:36+01:00 Improved error messages from fundep changes - - - - - b8d5945f by Simon Peyton Jones at 2025-08-16T23:18:43+01:00 More wibbles to Outputable - - - - - 16 changed files: - compiler/GHC/Utils/Outputable.hs - testsuite/tests/deriving/should_fail/T3621.stderr - testsuite/tests/indexed-types/should_fail/T9662.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr - testsuite/tests/parser/should_fail/T20654a.stderr - testsuite/tests/partial-sigs/should_fail/T14040a.stderr - testsuite/tests/typecheck/no_skolem_info/T14040.stderr - testsuite/tests/typecheck/should_fail/FD3.stderr - testsuite/tests/typecheck/should_fail/FDsFromGivens2.stderr - testsuite/tests/typecheck/should_fail/T13506.stderr - testsuite/tests/typecheck/should_fail/T19415b.stderr - testsuite/tests/typecheck/should_fail/T5246.stderr - testsuite/tests/typecheck/should_fail/T5978.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/T9612.stderr Changes: ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -522,20 +522,22 @@ pprDeeper d = SDoc $ \ctx -> case sdocStyle ctx of _ -> runSDoc d ctx --- | Truncate a list that is longer than the default depth +-- | Trim the list to the length of the remaining depth count pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc pprDeeperList f ds | null ds = f [] | otherwise = SDoc work where - -- Trim the list to the length of the remaining depth count - work ctx@SDC{ sdocStyle=PprUser _ depth _ } - | Just list_elts_to_print + work ctx@SDC{ sdocStyle=PprUser q depth c } + | Just n_remaining <- case depth of DefaultDepth -> Just (sdocDefaultDepth ctx) PartWay n -> Just n AllTheWay -> Nothing - = runSDoc (f (trim list_elts_to_print ds)) ctx + = runSDoc (f (trim n_remaining ds)) + -- Trim the length of the list + (ctx { sdocStyle = PprUser q (PartWay (n_remaining - 1)) c }) + -- ..and go deeper as we step inside the list elements work other_ctx = runSDoc (f ds) other_ctx ===================================== testsuite/tests/deriving/should_fail/T3621.stderr ===================================== @@ -1,15 +1,9 @@ -T3621.hs:24:43: error: [GHC-25897] - • Couldn't match type ‘s’ with ‘state’ - arising from a functional dependency between: - constraint ‘MonadState state (State s)’ - arising from the 'deriving' clause of a data type declaration - instance ‘MonadState s1 (State s1)’ at T3621.hs:21:10-31 - ‘s’ is a rigid type variable bound by - the deriving clause for ‘MonadState state (WrappedState s)’ - at T3621.hs:24:43-58 - ‘state’ is a rigid type variable bound by - the deriving clause for ‘MonadState state (WrappedState s)’ - at T3621.hs:24:43-58 +T3621.hs:24:43: error: [GHC-39999] + • No instance for ‘MonadState state (State s)’ + arising from the 'deriving' clause of a data type declaration + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself • When deriving the instance for (MonadState state (WrappedState s)) ===================================== testsuite/tests/indexed-types/should_fail/T9662.stderr ===================================== @@ -1,12 +1,12 @@ T9662.hs:49:8: error: [GHC-25897] - • Couldn't match type ‘n’ with ‘Int’ + • Couldn't match type ‘k’ with ‘Int’ Expected: Exp (((sh :. k) :. m) :. n) -> Exp (((sh :. m) :. n) :. k) Actual: Exp (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int)) -> Exp (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int)) - ‘n’ is a rigid type variable bound by + ‘k’ is a rigid type variable bound by the type signature for: test :: forall sh k m n. Shape (((sh :. k) :. m) :. n) -> Shape (((sh :. m) :. n) :. k) ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr ===================================== @@ -1,9 +1,9 @@ - -RecordDotSyntaxFail10.hs:40:11: error: [GHC-18872] - • Couldn't match type ‘Int’ with ‘[Char]’ +RecordDotSyntaxFail10.hs:40:11: error: [GHC-39999] + • No instance for ‘HasField "quux" Quux String’ • In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’ In a stmt of a 'do' block: print $ a {foo.bar.baz.quux} In the expression: - do let a = ... + do let a = Foo {foo = Bar {bar = ...}} let quux = "Expecto patronum!" print $ a {foo.bar.baz.quux} + ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr ===================================== @@ -1,13 +1,10 @@ - -RecordDotSyntaxFail13.hs:26:11: error: [GHC-18872] - • Couldn't match type ‘Int’ with ‘Foo -> Int’ - arising from a functional dependency between: - constraint ‘HasField "foo" Foo (Foo -> Int)’ - arising from a record update - instance ‘HasField "foo" Foo Int’ - at RecordDotSyntaxFail13.hs:21:10-31 +RecordDotSyntaxFail13.hs:26:11: error: [GHC-39999] + • No instance for ‘HasField "foo" Foo (Foo -> Int)’ + arising from a record update + (maybe you haven't applied a function to enough arguments?) • In the second argument of ‘($)’, namely ‘a {foo}’ In a stmt of a 'do' block: print $ a {foo} In the expression: - do let a = ... + do let a = Foo {foo = 12} print $ a {foo} + ===================================== testsuite/tests/parser/should_fail/T20654a.stderr ===================================== @@ -1,12 +1,10 @@ - -T20654a.hs:7:9: error: [GHC-18872] - • Couldn't match type: forall a. a -> a - with: Int -> Int - arising from a functional dependency between constraints: - ‘?poly::Int -> Int’ - arising from a use of implicit parameter ‘?poly’ at T20654a.hs:7:9-13 - ‘?poly::forall a. a -> a’ - arising from the type signature for: - foo :: (?poly::forall a. a -> a) => Int -> Int at T20654a.hs:6:1-48 +T20654a.hs:7:9: error: [GHC-91416] + • Could not deduce ‘?poly::Int -> Int’ + arising from a use of implicit parameter ‘?poly’ + from the context: ?poly::forall a. a -> a + bound by the type signature for: + foo :: (?poly::forall a. a -> a) => Int -> Int + at T20654a.hs:6:1-48 • In the expression: ?poly x In an equation for ‘foo’: foo x = ?poly x + ===================================== testsuite/tests/partial-sigs/should_fail/T14040a.stderr ===================================== @@ -1,6 +1,6 @@ T14040a.hs:26:46: error: [GHC-46956] - • Couldn't match kind ‘k0’ with ‘WeirdList z’ - Expected kind ‘WeirdList k0’, + • Couldn't match kind ‘k1’ with ‘WeirdList z’ + Expected kind ‘WeirdList k1’, but ‘xs’ has kind ‘WeirdList (WeirdList z)’ because kind variable ‘z’ would escape its scope This (rigid, skolem) kind variable is bound by @@ -24,8 +24,8 @@ T14040a.hs:26:46: error: [GHC-46956] -> p _ wl T14040a.hs:27:27: error: [GHC-46956] - • Couldn't match kind ‘k1’ with ‘z’ - Expected kind ‘WeirdList k1’, + • Couldn't match kind ‘k0’ with ‘z’ + Expected kind ‘WeirdList k0’, but ‘WeirdCons x xs’ has kind ‘WeirdList z’ because kind variable ‘z’ would escape its scope This (rigid, skolem) kind variable is bound by ===================================== testsuite/tests/typecheck/no_skolem_info/T14040.stderr ===================================== @@ -1,6 +1,6 @@ T14040.hs:27:46: error: [GHC-46956] - • Couldn't match kind ‘k0’ with ‘WeirdList z’ - Expected kind ‘WeirdList k0’, + • Couldn't match kind ‘k1’ with ‘WeirdList z’ + Expected kind ‘WeirdList k1’, but ‘xs’ has kind ‘WeirdList (WeirdList z)’ because kind variable ‘z’ would escape its scope This (rigid, skolem) kind variable is bound by @@ -24,8 +24,8 @@ T14040.hs:27:46: error: [GHC-46956] -> p _ wl T14040.hs:28:27: error: [GHC-46956] - • Couldn't match kind ‘k1’ with ‘z’ - Expected kind ‘WeirdList k1’, + • Couldn't match kind ‘k0’ with ‘z’ + Expected kind ‘WeirdList k0’, but ‘WeirdCons x xs’ has kind ‘WeirdList z’ because kind variable ‘z’ would escape its scope This (rigid, skolem) kind variable is bound by ===================================== testsuite/tests/typecheck/should_fail/FD3.stderr ===================================== @@ -1,15 +1,5 @@ - -FD3.hs:15:15: error: [GHC-25897] - • Couldn't match type ‘a’ with ‘(String, a)’ - arising from a functional dependency between: - constraint ‘MkA (String, a) a’ arising from a use of ‘mkA’ - instance ‘MkA a1 a1’ at FD3.hs:12:10-16 - ‘a’ is a rigid type variable bound by - the type signature for: - translate :: forall a. (String, a) -> A a - at FD3.hs:14:1-31 +FD3.hs:15:15: error: [GHC-39999] + • No instance for ‘MkA (String, a) a’ arising from a use of ‘mkA’ • In the expression: mkA a In an equation for ‘translate’: translate a = mkA a - • Relevant bindings include - a :: (String, a) (bound at FD3.hs:15:11) - translate :: (String, a) -> A a (bound at FD3.hs:15:1) + ===================================== testsuite/tests/typecheck/should_fail/FDsFromGivens2.stderr ===================================== @@ -1,13 +1,10 @@ - -FDsFromGivens2.hs:15:15: error: [GHC-18872] - • Couldn't match type ‘Char’ with ‘[a]’ - arising from a functional dependency between constraints: - ‘C Char [a]’ arising from a use of ‘f’ at FDsFromGivens2.hs:15:15 - ‘C Char Char’ - arising from a pattern with constructor: - KCC :: C Char Char => () -> KCC, - in an equation for ‘bar’ at FDsFromGivens2.hs:15:6-10 +FDsFromGivens2.hs:15:15: error: [GHC-39999] + • Could not deduce ‘C Char [a]’ arising from a use of ‘f’ + from the context: C Char Char + bound by a pattern with constructor: + KCC :: C Char Char => () -> KCC, + in an equation for ‘bar’ + at FDsFromGivens2.hs:15:6-10 • In the expression: f In an equation for ‘bar’: bar (KCC _) = f - • Relevant bindings include - bar :: KCC -> a -> a (bound at FDsFromGivens2.hs:15:1) + ===================================== testsuite/tests/typecheck/should_fail/T13506.stderr ===================================== @@ -1,8 +1,6 @@ - -T13506.hs:16:12: error: [GHC-18872] - • Couldn't match type ‘Char’ with ‘()’ - arising from a functional dependency between: - constraint ‘FunDep [Char] ()’ arising from a use of ‘singleton’ - instance ‘FunDep [a] a’ at T13506.hs:5:10-21 +T13506.hs:16:12: error: [GHC-39999] + • No instance for ‘FunDep [Char] ()’ + arising from a use of ‘singleton’ • In the expression: singleton () In an equation for ‘illTyped’: illTyped = singleton () + ===================================== testsuite/tests/typecheck/should_fail/T19415b.stderr ===================================== @@ -1,8 +1,6 @@ - -T19415b.hs:15:8: error: [GHC-18872] - • Couldn't match type ‘Int’ with ‘Char’ - arising from a functional dependency between: - constraint ‘Ping (T a0) (T b) Char’ arising from a use of ‘foo’ - instance ‘Ping (T a) (T b1) Int’ at T19415b.hs:12:10-53 +T19415b.hs:15:8: error: [GHC-39999] + • No instance for ‘Ping (T a0) (T b0) Char’ + arising from a use of ‘foo’ • In the expression: foo 'c' MkT In an equation for ‘loop’: loop = foo 'c' MkT + ===================================== testsuite/tests/typecheck/should_fail/T5246.stderr ===================================== @@ -1,10 +1,9 @@ - -T5246.hs:11:10: error: [GHC-18872] - • Couldn't match type ‘[Char]’ with ‘Int’ - arising from a functional dependency between constraints: - ‘?x::Int’ arising from a use of ‘foo’ at T5246.hs:11:10-12 - ‘?x::String’ - arising from the implicit-parameter binding for ?x at T5246.hs:(10,7)-(11,12) +T5246.hs:11:10: error: [GHC-91416] + • Could not deduce ‘?x::Int’ arising from a use of ‘foo’ + from the context: ?x::String + bound by the implicit-parameter binding for ?x + at T5246.hs:(10,7)-(11,12) • In the expression: foo In the expression: let ?x = "hello" in foo In an equation for ‘bar’: bar = let ?x = "hello" in foo + ===================================== testsuite/tests/typecheck/should_fail/T5978.stderr ===================================== @@ -1,8 +1,5 @@ - -T5978.hs:22:11: error: [GHC-18872] - • Couldn't match type ‘Bool’ with ‘Char’ - arising from a functional dependency between: - constraint ‘C Double Char’ arising from a use of ‘polyBar’ - instance ‘C Double Bool’ at T5978.hs:8:10-22 +T5978.hs:22:11: error: [GHC-39999] + • No instance for ‘C Double Char’ arising from a use of ‘polyBar’ • In the expression: polyBar id monoFoo In an equation for ‘monoBar’: monoBar = polyBar id monoFoo + ===================================== testsuite/tests/typecheck/should_fail/T8603.stderr ===================================== @@ -3,8 +3,8 @@ T8603.hs:33:17: error: [GHC-18872] When matching types m0 :: * -> * [a2] :: * - Expected: [a2] -> StateT s RV a1 - Actual: t0 m0 (StateT s RV a1) + Expected: [a2] -> StateT s RV a0 + Actual: t0 m0 (StateT s RV a0) • The function ‘lift’ is applied to two visible arguments, but its type ‘(Control.Monad.Trans.Class.MonadTrans t, Monad m) => m a -> t m a’ ===================================== testsuite/tests/typecheck/should_fail/T9612.stderr ===================================== @@ -1,11 +1,11 @@ - -T9612.hs:16:9: error: [GHC-18872] - • Couldn't match type: [(Int, a)] - with: (Int, a) - arising from a functional dependency between: - constraint ‘MonadWriter (Int, a) (WriterT [(Int, a)] Identity)’ - arising from a use of ‘tell’ - instance ‘MonadWriter w (WriterT w m)’ at T9612.hs:20:10-59 +T9612.hs:16:9: error: [GHC-39999] + • Could not deduce ‘MonadWriter + (Int, a) (WriterT [(Int, a)] Identity)’ + arising from a use of ‘tell’ + from the context: Eq a + bound by the type signature for: + f :: forall a. Eq a => a -> (Int, a) -> Writer [(Int, a)] (Int, a) + at T9612.hs:13:1-57 • In a stmt of a 'do' block: tell (n, x) In the expression: do tell (n, x) @@ -14,8 +14,4 @@ T9612.hs:16:9: error: [GHC-18872] f y (n, x) = do tell (n, x) return (1, y) - • Relevant bindings include - x :: a (bound at T9612.hs:14:8) - y :: a (bound at T9612.hs:14:3) - f :: a -> (Int, a) -> Writer [(Int, a)] (Int, a) - (bound at T9612.hs:14:1) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/164590b57b9bd0ff7f18bb0bef2ed5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/164590b57b9bd0ff7f18bb0bef2ed5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/hiddenmodules-uniqset] 2 commits: driver: use UniqSet for hiddenModules in DynFlags/FinderOpts
by Cheng Shao (＠TerrorJack) 16 Aug '25

16 Aug '25

Cheng Shao pushed to branch wip/hiddenmodules-uniqset at Glasgow Haskell Compiler / GHC Commits: fbf8d52b by Cheng Shao at 2025-08-16T19:39:35+02:00 driver: use UniqSet for hiddenModules in DynFlags/FinderOpts This patch replaces Set ModuleName with UniqSet ModuleName in DynFlags.hiddenModules and FinderOpts.finder_hiddenModules for improved efficiency. Co-authored-by: Codex <codex(a)openai.com> - - - - - 96513732 by Cheng Shao at 2025-08-16T19:42:26+02:00 driver: use UniqMap ModuleName in the finder This patch replaces Map ModuleName with UniqMap ModuleName in the finder for improved efficiency. Co-authored-by: Codex <codex(a)openai.com> - - - - - 7 changed files: - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs Changes: ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString import GHC.Data.OsPath -import qualified Data.Map as Map +import GHC.Types.Unique.Map -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts @@ -22,7 +22,7 @@ initFinderOpts flags = FinderOpts , finder_workingDirectory = fmap unsafeEncodeUtf $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags - , finder_reexportedModules = Map.fromList [(known_as, is_as) | ReexportedModule is_as known_as <- reverse (reexportedModules flags)] + , finder_reexportedModules = listToUniqMap [(known_as, is_as) | ReexportedModule is_as known_as <- reverse (reexportedModules flags)] , finder_hieDir = fmap unsafeEncodeUtf $ hieDir flags , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags , finder_hiDir = fmap unsafeEncodeUtf $ hiDir flags ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -143,6 +143,7 @@ import System.Directory import GHC.Foreign (withCString, peekCString) import qualified Data.Set as Set +import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt @@ -261,7 +262,7 @@ data DynFlags = DynFlags { -- Note [Filepaths and Multiple Home Units] workingDirectory :: Maybe FilePath, thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, + hiddenModules :: !(UniqSet ModuleName), reexportedModules :: [ReexportedModule], -- ways @@ -597,7 +598,7 @@ defaultDynFlags mySettings = workingDirectory = Nothing, thisPackageName = Nothing, - hiddenModules = Set.empty, + hiddenModules = emptyUniqSet, reexportedModules = [], objectDir = Nothing, ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -109,13 +109,14 @@ import GHC.Unit.Module.ModDetails import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Types.Unique.Set import Control.Concurrent.MVar import Control.Monad import qualified Control.Monad.Catch as MC import Data.IORef import Data.Maybe -import Data.List (sortOn, groupBy, sortBy) +import Data.List (sort, sortOn, groupBy, sortBy) import qualified Data.List as List import System.FilePath @@ -313,14 +314,15 @@ warnUnknownModules hsc_env dflags mod_graph = do where diag_opts = initDiagOpts dflags - unit_mods = Set.fromList (map ms_mod_name + unit_mods :: UniqSet ModuleName + unit_mods = mkUniqSet (map ms_mod_name (filter (\ms -> ms_unitid ms == homeUnitId_ dflags) (mgModSummaries mod_graph))) reexported_mods = reexportedModules dflags hidden_mods = hiddenModules dflags - hidden_warns = hidden_mods `Set.difference` unit_mods + hidden_warns = hidden_mods `minusUniqSet` unit_mods lookupModule mn = findImportedModule hsc_env mn NoPkgQual @@ -337,7 +339,7 @@ warnUnknownModules hsc_env dflags mod_graph = do final_msgs hidden_warns reexported_warns = unionManyMessages $ - [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (Set.toList hidden_warns)) | not (Set.null hidden_warns)] + [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (sort $ nonDetEltsUniqSet hidden_warns)) | not (isEmptyUniqSet hidden_warns)] ++ [warn (DriverUnknownReexportedModules (homeUnitId_ dflags) reexported_warns) | not (null reexported_warns)] -- | Describes which modules of the module graph need to be loaded. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -293,6 +293,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Types.Unique.Set import Data.Word import System.FilePath import Text.ParserCombinators.ReadP hiding (char) @@ -3153,7 +3154,7 @@ setPackageName p d = d { thisPackageName = Just p } addHiddenModule :: String -> DynP () addHiddenModule p = - upd (\s -> s{ hiddenModules = Set.insert (mkModuleName p) (hiddenModules s) }) + upd (\s -> s{ hiddenModules = addOneToUniqSet (hiddenModules s) (mkModuleName p) }) addReexportedModule :: String -> DynP () addReexportedModule p = ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -175,7 +175,7 @@ mkDocStructureFromExportList mdl import_avails export_list = moduleExport alias avails = DsiModExport (nubSortNE orig_names) (sortAvails (nubAvails avails)) where - orig_names = M.findWithDefault aliasErr alias aliasMap + orig_names = fromMaybe aliasErr (lookupUniqMap aliasMap alias) aliasErr = error $ "mkDocStructureFromExportList: " ++ (moduleNameString . moduleName) mdl ++ ": Can't find alias " ++ moduleNameString alias @@ -185,9 +185,9 @@ mkDocStructureFromExportList mdl import_avails export_list = NonEmpty.toList -- Map from aliases to true module names. - aliasMap :: Map ModuleName (NonEmpty ModuleName) + aliasMap :: UniqMap ModuleName (NonEmpty ModuleName) aliasMap = - M.fromListWith (S.<>) $ + listToUniqMap_C (S.<>) $ (this_mdl_name, this_mdl_name :| []) : (flip concatMap (M.toList imported) $ \(mdl, imvs) -> [(imv_name imv, moduleName mdl :| []) | imv <- imvs]) ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -65,9 +65,10 @@ import Control.Applicative ((<|>)) import Control.Monad import Data.Time import qualified Data.Map as M +import GHC.Types.Unique.Map import GHC.Driver.Env import GHC.Driver.Config.Finder -import qualified Data.Set as Set +import GHC.Types.Unique.Set import Data.List.NonEmpty ( NonEmpty (..) ) import qualified System.OsPath as OsPath import qualified Data.List.NonEmpty as NE @@ -194,9 +195,9 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg = home_pkg_import (uid, opts) -- If the module is reexported, then look for it as if it was from the perspective -- of that package which reexports it. - | Just real_mod_name <- mod_name `M.lookup` finder_reexportedModules opts = + | Just real_mod_name <- lookupUniqMap (finder_reexportedModules opts) mod_name = findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual - | mod_name `Set.member` finder_hiddenModules opts = + | elementOfUniqSet mod_name (finder_hiddenModules opts) = return (mkHomeHidden uid) | otherwise = findHomePackageModule fc opts uid mod_name @@ -794,4 +795,3 @@ findObjectLinkable mod obj_fn obj_time = pure (Linkable obj_time mod (NE.singleton (DotO obj_fn ModuleObject))) -- We used to look for _stub.o files here, but that was a bug (#706) -- Now GHC merges the stub.o into the main .o (#3687) - ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -12,12 +12,13 @@ import GHC.Prelude import GHC.Unit import GHC.Data.OsPath import qualified Data.Map as M +import GHC.Types.Unique.Map import GHC.Fingerprint import GHC.Platform.Ways import GHC.Unit.Env import GHC.Data.FastString -import qualified Data.Set as Set +import GHC.Types.Unique.Set -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -101,8 +102,8 @@ data FinderOpts = FinderOpts -- that have a similar name. , finder_workingDirectory :: Maybe OsPath , finder_thisPackageName :: Maybe FastString - , finder_hiddenModules :: Set.Set ModuleName - , finder_reexportedModules :: M.Map ModuleName ModuleName -- Reverse mapping, if you are looking for this name then look for this module. + , finder_hiddenModules :: !(UniqSet ModuleName) + , finder_reexportedModules :: !(UniqMap ModuleName ModuleName) -- Reverse mapping, if you are looking for this name then look for this module. , finder_hieDir :: Maybe OsPath , finder_hieSuf :: OsString , finder_hiDir :: Maybe OsPath View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b09b64e884f6f3943d803b0e21540f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b09b64e884f6f3943d803b0e21540f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/hiddenmodules-uniqset] driver: use UniqSet for hiddenModules in DynFlags/FinderOpts
by Cheng Shao (＠TerrorJack) 16 Aug '25

16 Aug '25

Cheng Shao pushed to branch wip/hiddenmodules-uniqset at Glasgow Haskell Compiler / GHC Commits: b09b64e8 by Cheng Shao at 2025-08-16T16:38:29+02:00 driver: use UniqSet for hiddenModules in DynFlags/FinderOpts This patch replaces Set ModuleName with UniqSet ModuleName in DynFlags.hiddenModules and FinderOpts.finder_hiddenModules for improved efficiency. Co-authored-by: Codex <codex(a)openai.com> - - - - - 5 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -143,6 +143,7 @@ import System.Directory import GHC.Foreign (withCString, peekCString) import qualified Data.Set as Set +import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt @@ -261,7 +262,7 @@ data DynFlags = DynFlags { -- Note [Filepaths and Multiple Home Units] workingDirectory :: Maybe FilePath, thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, + hiddenModules :: !(UniqSet ModuleName), reexportedModules :: [ReexportedModule], -- ways @@ -597,7 +598,7 @@ defaultDynFlags mySettings = workingDirectory = Nothing, thisPackageName = Nothing, - hiddenModules = Set.empty, + hiddenModules = emptyUniqSet, reexportedModules = [], objectDir = Nothing, ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -109,13 +109,14 @@ import GHC.Unit.Module.ModDetails import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Types.Unique.Set import Control.Concurrent.MVar import Control.Monad import qualified Control.Monad.Catch as MC import Data.IORef import Data.Maybe -import Data.List (sortOn, groupBy, sortBy) +import Data.List (sort, sortOn, groupBy, sortBy) import qualified Data.List as List import System.FilePath @@ -313,14 +314,15 @@ warnUnknownModules hsc_env dflags mod_graph = do where diag_opts = initDiagOpts dflags - unit_mods = Set.fromList (map ms_mod_name + unit_mods :: UniqSet ModuleName + unit_mods = mkUniqSet (map ms_mod_name (filter (\ms -> ms_unitid ms == homeUnitId_ dflags) (mgModSummaries mod_graph))) reexported_mods = reexportedModules dflags hidden_mods = hiddenModules dflags - hidden_warns = hidden_mods `Set.difference` unit_mods + hidden_warns = hidden_mods `minusUniqSet` unit_mods lookupModule mn = findImportedModule hsc_env mn NoPkgQual @@ -337,7 +339,7 @@ warnUnknownModules hsc_env dflags mod_graph = do final_msgs hidden_warns reexported_warns = unionManyMessages $ - [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (Set.toList hidden_warns)) | not (Set.null hidden_warns)] + [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (sort $ nonDetEltsUniqSet hidden_warns)) | not (isEmptyUniqSet hidden_warns)] ++ [warn (DriverUnknownReexportedModules (homeUnitId_ dflags) reexported_warns) | not (null reexported_warns)] -- | Describes which modules of the module graph need to be loaded. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -293,6 +293,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Types.Unique.Set import Data.Word import System.FilePath import Text.ParserCombinators.ReadP hiding (char) @@ -3153,7 +3154,7 @@ setPackageName p d = d { thisPackageName = Just p } addHiddenModule :: String -> DynP () addHiddenModule p = - upd (\s -> s{ hiddenModules = Set.insert (mkModuleName p) (hiddenModules s) }) + upd (\s -> s{ hiddenModules = addOneToUniqSet (hiddenModules s) (mkModuleName p) }) addReexportedModule :: String -> DynP () addReexportedModule p = ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -67,7 +67,7 @@ import Data.Time import qualified Data.Map as M import GHC.Driver.Env import GHC.Driver.Config.Finder -import qualified Data.Set as Set +import GHC.Types.Unique.Set import Data.List.NonEmpty ( NonEmpty (..) ) import qualified System.OsPath as OsPath import qualified Data.List.NonEmpty as NE @@ -196,7 +196,7 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg = -- of that package which reexports it. | Just real_mod_name <- mod_name `M.lookup` finder_reexportedModules opts = findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual - | mod_name `Set.member` finder_hiddenModules opts = + | elementOfUniqSet mod_name (finder_hiddenModules opts) = return (mkHomeHidden uid) | otherwise = findHomePackageModule fc opts uid mod_name @@ -794,4 +794,3 @@ findObjectLinkable mod obj_fn obj_time = pure (Linkable obj_time mod (NE.singleton (DotO obj_fn ModuleObject))) -- We used to look for _stub.o files here, but that was a bug (#706) -- Now GHC merges the stub.o into the main .o (#3687) - ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -17,7 +17,7 @@ import GHC.Platform.Ways import GHC.Unit.Env import GHC.Data.FastString -import qualified Data.Set as Set +import GHC.Types.Unique.Set -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -101,7 +101,7 @@ data FinderOpts = FinderOpts -- that have a similar name. , finder_workingDirectory :: Maybe OsPath , finder_thisPackageName :: Maybe FastString - , finder_hiddenModules :: Set.Set ModuleName + , finder_hiddenModules :: UniqSet ModuleName , finder_reexportedModules :: M.Map ModuleName ModuleName -- Reverse mapping, if you are looking for this name then look for this module. , finder_hieDir :: Maybe OsPath , finder_hieSuf :: OsString View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b09b64e884f6f3943d803b0e21540fa… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b09b64e884f6f3943d803b0e21540fa… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/hiddenmodules-uniqset
by Cheng Shao (＠TerrorJack) 16 Aug '25

16 Aug '25

Cheng Shao pushed new branch wip/hiddenmodules-uniqset at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hiddenmodules-uniqset You're receiving this email because of your account on gitlab.haskell.org.

1 0