November 2025 - ghc-commits

[Git][ghc/ghc][wip/spj-apporv-Oct24] make sure landmark error contexts are always printed. accept some testcases
by Apoorv Ingle (＠ani) 23 Nov '25

23 Nov '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 32ac5a05 by Apoorv Ingle at 2025-11-23T16:42:39-06:00 make sure landmark error contexts are always printed. accept some testcases - - - - - 8 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Utils/Monad.hs - testsuite/tests/default/default-fail05.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/polykinds/T13393.stderr - testsuite/tests/typecheck/should_compile/T14590.stderr - testsuite/tests/typecheck/should_fail/T6069.stderr Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -897,9 +897,9 @@ ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e ppr_expr (SectionL _ expr op) | Just pp_op <- ppr_infix_expr (unLoc op) - = text "<SectionL>" <+> pp_infixly pp_op + = pp_infixly pp_op | otherwise - = text "<SectionL>" <+> pp_prefixly + = pp_prefixly where pp_expr = pprDebugParendExpr opPrec expr @@ -910,9 +910,9 @@ ppr_expr (SectionL _ expr op) ppr_expr (SectionR _ op expr) | Just pp_op <- ppr_infix_expr (unLoc op) - = text "<SectionR>" <+> pp_infixly pp_op + = pp_infixly pp_op | otherwise - = text "<SectionR>" <+> pp_prefixly + = pp_prefixly where pp_expr = pprDebugParendExpr opPrec expr ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -186,7 +186,7 @@ Note [Instantiation variables are short lived] tcExprSigma :: Bool -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) tcExprSigma inst rn_expr = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr - ; ds_flag <- getDeepSubsumptionFlag_DataConHead rn_fun + -- ; ds_flag <- getDeepSubsumptionFlag_DataConHead rn_fun -- ; do_ql <- wantQuickLook rn_fun ; (tc_fun, fun_sigma) <- tcInferAppHead fun ; code_orig <- getSrcCodeOrigin ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1845,12 +1845,9 @@ mkErrCtxt env ctxts go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg] go _ _ _ [] = return [] go dbg n env (MkErrCtxt LandmarkUserSrcCode ctxt : ctxts) - | n < mAX_CONTEXTS -- Too verbose || dbg = do { (env', msg) <- liftZonkM $ ctxt env ; rest <- go dbg n env' ctxts ; return (msg : rest) } - | otherwise - = go dbg n env ctxts go dbg n env (MkErrCtxt _ ctxt : ctxts) | n < mAX_CONTEXTS -- Too verbose || dbg = do { (env', msg) <- liftZonkM $ ctxt env ===================================== testsuite/tests/default/default-fail05.stderr ===================================== @@ -1,69 +1,70 @@ default-fail05.hs:11:10: error: [GHC-39999] - • Ambiguous type variable ‘f0’ arising from a use of ‘toList’ - prevents the constraint ‘(Foldable f0)’ from being solved. - Probable fix: use a type annotation to specify what ‘f0’ should be. + • Ambiguous type variable ‘t0’ arising from a use of ‘toList’ + prevents the constraint ‘(Foldable t0)’ from being solved. + Probable fix: use a type annotation to specify what ‘t0’ should be. Potentially matching instances: - instance Foldable (Either a) - -- Defined in ‘GHC.Internal.Data.Foldable’ - instance Foldable Maybe -- Defined in ‘GHC.Internal.Data.Foldable’ - ...plus three others - ...plus 26 instances involving out-of-scope types - (use -fprint-potential-instances to see them all) + instance Foldable (Either a) + -- Defined in ‘GHC.Internal.Data.Foldable’ + instance Foldable Maybe -- Defined in ‘GHC.Internal.Data.Foldable’ + ...plus three others + ...plus 26 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) • In the first argument of ‘($)’, namely ‘toList’ In the first argument of ‘print’, namely ‘(toList $ pure 21)’ In a stmt of a 'do' block: print (toList $ pure 21) default-fail05.hs:11:19: error: [GHC-39999] - • Ambiguous type variable ‘f0’ arising from a use of ‘pure’ - prevents the constraint ‘(Applicative f0)’ from being solved. - Probable fix: use a type annotation to specify what ‘f0’ should be. + • Ambiguous type variable ‘t0’ arising from a use of ‘pure’ + prevents the constraint ‘(Applicative t0)’ from being solved. + Probable fix: use a type annotation to specify what ‘t0’ should be. Potentially matching instances: - instance Applicative IO -- Defined in ‘GHC.Internal.Base’ - instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’ - ...plus six others - ...plus 9 instances involving out-of-scope types - (use -fprint-potential-instances to see them all) + instance Applicative IO -- Defined in ‘GHC.Internal.Base’ + instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’ + ...plus six others + ...plus 9 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) • In the second argument of ‘($)’, namely ‘pure 21’ In the first argument of ‘print’, namely ‘(toList $ pure 21)’ In a stmt of a 'do' block: print (toList $ pure 21) default-fail05.hs:12:3: error: [GHC-39999] - • Ambiguous type variable ‘t0’ arising from a use of ‘traverse’ - prevents the constraint ‘(Traversable t0)’ from being solved. + • Ambiguous type variable ‘t1’ arising from a use of ‘traverse’ + prevents the constraint ‘(Traversable t1)’ from being solved. Relevant bindings include - main :: IO (t0 ()) (bound at default-fail05.hs:10:1) - Probable fix: use a type annotation to specify what ‘t0’ should be. + main :: IO (t1 ()) (bound at default-fail05.hs:10:1) + Probable fix: use a type annotation to specify what ‘t1’ should be. Potentially matching instances: - instance Traversable (Either a) - -- Defined in ‘GHC.Internal.Data.Traversable’ - instance Traversable Maybe - -- Defined in ‘GHC.Internal.Data.Traversable’ - ...plus three others - ...plus 28 instances involving out-of-scope types - (use -fprint-potential-instances to see them all) + instance Traversable (Either a) + -- Defined in ‘GHC.Internal.Data.Traversable’ + instance Traversable Maybe + -- Defined in ‘GHC.Internal.Data.Traversable’ + ...plus three others + ...plus 28 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) • In a stmt of a 'do' block: traverse print (pure 42) In the expression: - do print (toList $ pure 21) - traverse print (pure 42) + do print (toList $ pure 21) + traverse print (pure 42) In an equation for ‘main’: - main - = do print (toList $ pure 21) - traverse print (pure 42) + main + = do print (toList $ pure 21) + traverse print (pure 42) default-fail05.hs:12:19: error: [GHC-39999] - • Ambiguous type variable ‘t0’ arising from a use of ‘pure’ - prevents the constraint ‘(Applicative t0)’ from being solved. + • Ambiguous type variable ‘t1’ arising from a use of ‘pure’ + prevents the constraint ‘(Applicative t1)’ from being solved. Relevant bindings include - main :: IO (t0 ()) (bound at default-fail05.hs:10:1) - Probable fix: use a type annotation to specify what ‘t0’ should be. + main :: IO (t1 ()) (bound at default-fail05.hs:10:1) + Probable fix: use a type annotation to specify what ‘t1’ should be. Potentially matching instances: - instance Applicative IO -- Defined in ‘GHC.Internal.Base’ - instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’ - ...plus six others - ...plus 9 instances involving out-of-scope types - (use -fprint-potential-instances to see them all) + instance Applicative IO -- Defined in ‘GHC.Internal.Base’ + instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’ + ...plus six others + ...plus 9 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) • In the second argument of ‘traverse’, namely ‘(pure 42)’ In a stmt of a 'do' block: traverse print (pure 42) In the expression: - do print (toList $ pure 21) - traverse print (pure 42) + do print (toList $ pure 21) + traverse print (pure 42) + ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr ===================================== @@ -3,23 +3,22 @@ RecordDotSyntaxFail11.hs:8:3: error: [GHC-39999] prevents the constraint ‘(Show a0)’ from being solved. Probable fix: use a type annotation to specify what ‘a0’ should be. Potentially matching instances: - instance Show Ordering -- Defined in ‘GHC.Internal.Show’ - instance Show Integer -- Defined in ‘GHC.Internal.Show’ - ...plus 25 others - ...plus 13 instances involving out-of-scope types - (use -fprint-potential-instances to see them all) + instance Show Ordering -- Defined in ‘GHC.Internal.Show’ + instance Show Integer -- Defined in ‘GHC.Internal.Show’ + ...plus 25 others + ...plus 13 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) • In the first argument of ‘($)’, namely ‘print’ In a stmt of a 'do' block: print $ (.foo.bar.baz) a In the expression: - do let a = Foo {foo = ...} - print $ (.foo.bar.baz) a + do let a = Foo {foo = ...} + print $ (.foo.bar.baz) a RecordDotSyntaxFail11.hs:8:11: error: [GHC-39999] • No instance for ‘GHC.Internal.Records.HasField "baz" Int a0’ - arising from the expression (.foo.bar.baz) + arising from the expression (.foo.bar.baz) NB: ‘Int’ is not a record type. - • In the second argument of ‘($)’, namely ‘(.foo.bar.baz) a’ + • In the expression: (.foo.bar.baz) + In the second argument of ‘($)’, namely ‘(.foo.bar.baz) a’ In a stmt of a 'do' block: print $ (.foo.bar.baz) a - In the expression: - do let a = Foo {foo = ...} - print $ (.foo.bar.baz) a + ===================================== testsuite/tests/polykinds/T13393.stderr ===================================== @@ -1,5 +1,5 @@ T13393.hs:61:3: error: [GHC-39999] - • Ambiguous type variable ‘t0’ arising from a do statement + • Ambiguous type variable ‘t0’ arising from a use of ‘mapM’ prevents the constraint ‘(Traversable t0)’ from being solved. Probable fix: use a type annotation to specify what ‘t0’ should be. Potentially matching instances: ===================================== testsuite/tests/typecheck/should_compile/T14590.stderr ===================================== @@ -1,6 +1,7 @@ T14590.hs:4:13: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int -> Int -> Int - • In the expression: (x `_`) y + • In the expression: x `_` + In the expression: (x `_`) y In an equation for ‘f1’: f1 x y = (x `_`) y • Relevant bindings include y :: Int (bound at T14590.hs:4:6) @@ -87,7 +88,8 @@ T14590.hs:4:13: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] T14590.hs:5:13: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: Int -> Int -> Int Or perhaps ‘_a’ is mis-spelled, or not in scope - • In the expression: (x `_a`) y + • In the expression: x `_a` + In the expression: (x `_a`) y In an equation for ‘f2’: f2 x y = (x `_a`) y • Relevant bindings include y :: Int (bound at T14590.hs:5:6) @@ -173,7 +175,8 @@ T14590.hs:5:13: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] T14590.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int -> Int -> Int - • In the expression: (`_` x) y + • In the expression: `_` x + In the expression: (`_` x) y In an equation for ‘f3’: f3 x y = (`_` x) y • Relevant bindings include y :: Int (bound at T14590.hs:6:6) @@ -260,7 +263,8 @@ T14590.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] T14590.hs:7:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: Int -> Int -> Int Or perhaps ‘_a’ is mis-spelled, or not in scope - • In the expression: (`_a` x) y + • In the expression: `_a` x + In the expression: (`_a` x) y In an equation for ‘f4’: f4 x y = (`_a` x) y • Relevant bindings include y :: Int (bound at T14590.hs:7:6) ===================================== testsuite/tests/typecheck/should_fail/T6069.stderr ===================================== @@ -22,6 +22,6 @@ T6069.hs:15:16: error: [GHC-83865] Expected: ST s2 Int -> b2 Actual: (forall s. ST s b2) -> b2 • In the second argument of ‘(.)’, namely ‘runST’ - In the expression: print . runST + In the first argument of ‘($)’, namely ‘(print . runST)’ In the expression: (print . runST) $ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32ac5a0589a73993ecc6b5e2601b9d3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32ac5a0589a73993ecc6b5e2601b9d3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] 12 commits: Fix #26293 Valid stack.yaml for hadrian
by Apoorv Ingle (＠ani) 23 Nov '25

23 Nov '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 682bf979 by Mike Pilgrem at 2025-11-16T16:44:14+00:00 Fix #26293 Valid stack.yaml for hadrian - - - - - acc70c3a by Simon Peyton Jones at 2025-11-18T16:21:20-05:00 Fix a bug in defaulting Addresses #26582 Defaulting was doing some unification but then failing to iterate. Silly. I discovered that the main solver was unnecessarily iterating even if there was a unification for an /outer/ unification variable, so I fixed that too. - - - - - c12fa73e by Simon Peyton Jones at 2025-11-19T02:55:01-05:00 Make PmLit be in Ord, and use it in Map This MR addresses #26514, by changing from data PmAltConSet = PACS !(UniqDSet ConLike) ![PmLit] to data PmAltConSet = PACS !(UniqDSet ConLike) !(Map PmLit PmLit) This matters when doing pattern-match overlap checking, when there is a very large set of patterns. For most programs it makes no difference at all. For the N=5000 case of the repro case in #26514, compiler mutator time (with `-fno-code`) goes from 1.9s to 0.43s. All for the price for an Ord instance for PmLit - - - - - 41b84f40 by sheaf at 2025-11-19T02:55:52-05:00 Add passing tests for #26311 and #26072 This commit adds two tests cases that now pass since landing the changes to typechecking of data constructors in b33284c7. Fixes #26072 #26311 - - - - - 1faa758a by sheaf at 2025-11-19T02:55:52-05:00 mkCast: weaken bad cast warning for multiplicity This commit weakens the warning message emitted when constructing a bad cast in mkCast to ignore multiplicity. Justification: since b33284c7, GHC uses sub-multiplicity coercions to typecheck data constructors. The coercion optimiser is free to discard these coercions, both for performance reasons, and because GHC's Core simplifier does not (yet) preserve linearity. We thus weaken 'mkCast' to use 'eqTypeIgnoringMultiplicity' instead of 'eqType', to avoid getting many spurious warnings about mismatched multiplicities. - - - - - 55eab80d by Sylvain Henry at 2025-11-20T17:33:13-05:00 Build external interpreter program on demand (#24731) This patch teaches GHC how to build the external interpreter program when it is missing. As long as we have the `ghci` library, doing this is trivial so most of this patch is refactoring for doing it sanely. - - - - - 08bbc028 by Rodrigo Mesquita at 2025-11-20T17:33:54-05:00 Add tests for #23973 and #26565 These were fixed by 4af4f0f070f83f948e49ad5d7835fd91b8d3f0e6 in !10417 - - - - - 6b42232c by sheaf at 2025-11-20T17:34:35-05:00 Mark T26410_ffi as fragile on Windows As seen in #26595, this test intermittently fails on Windows. This commit marks it as fragile, until we get around to fixing it. - - - - - b7b7c049 by Andrew Lelechenko at 2025-11-21T21:04:01+00:00 Add nubOrd / nubOrdBy to Data.List and Data.List.NonEmpty As per https://github.com/haskell/core-libraries-committee/issues/336 - - - - - 352d5462 by Marc Scholten at 2025-11-22T10:33:03-05:00 Fix haddock test runner to handle UTF-8 output xhtml 3000.4.0.0 now produces UTF-8 output instead of escaping non-ASCII characters. When using --test-accept it previously wrote files in the wrong encoding because they have not been decoded properly when reading the files. - - - - - b6599f14 by Apoorv Ingle at 2025-11-23T15:07:39-06:00 This commit: - Streamlines implementations of `tcExpr` and `tcXExpr` to work on `XExpr` Calls `setInGeneratedCode` everytime the typechecker goes over an `XExpr` - Kills `VACtxt` (and its associated VAExpansion and VACall) datatype, it is subsumed by simply a SrcSpan. - Kills the function `addHeadCtxt` as it is now mearly setting a location - The function `tcValArgs` does its own argument number management - Makes `splitHsApps` not look through `XExpr` - `tcExprSigma` is called if the head of the expression after calling `splitHsApps` turns out to be an `XExpr` - Removes location information from `OrigPat` payload - Removes special case of tcBody from `tcLambdaMatches` - Removes special case of `dsExpr` for `ExpandedThingTc` - Moves `setQLInstLevel` inside `tcInstFun` - Rename `HsThingRn` to `SrcCodeCtxt` - Kills `tcl_in_gen_code` and `tcl_err_ctxt`. It is subsumed by `ErrCtxtStack` - Kills `ExpectedFunTyOrig`. It is subsumed by `CtOrigin` - Fixes `CtOrigin` for `HsProjection` case in `exprCtOrigin`. It was previously assigned to be `SectionOrigin`. It is now just the expression - Adds a new `CtOrigin.ExpansionOrigin` for storing the original syntax - Adds a new `CtOrigin.ExpectedTySyntax` as a replacement for `ExpectedTySyntaxOp`. Cannot kill the former yet because of `ApplicativeDo` - Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr` - Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span` Notes added [Error Context Stack] Notes updated Note [Expanding HsDo with XXExprGhcRn] ------------------------- Metric Decrease: T9020 ------------------------- - - - - - 41ad73c3 by Apoorv Ingle at 2025-11-23T15:07:40-06:00 - kill PopErrCtxt - Pass in the location of the head of the application chain to `addArgCtxt` to print better error messages. Make `addArgCtxt` print in the nth argument if the head of the application chain is user located. - match context with record updates dont get added in error context - Do not use HsPar in Last statement - simplify addArgCtxt and push setSrcSpan inside addLExprCtxt. Make sure addExprCtxt is not called by itself - fun_orig in tcApp depends on the SrcSpan of the head of the application chain (similar to addArgCtxt) - rename fun_ctxt to fun_lspan, fun_orig passed in tcInstFun to default to app chain head if its user located, fall back to srcCodeOrigin if it's a generated location - fix quickLookArg function to blame the correct application chain head. The arguments application chain head should be blamed, not the original head when we quick look arg - Make sure only expression wrapped around generated src span are ignored while adding them to the error context stack - In `addArgCtxt` the nth argument's err ctxt adds a generated error ctxt if the argument is XExpr - - - - - 121 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/Core/Utils.hs - + compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/Config/Linker.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Linker/Config.hs - compiler/GHC/Linker/Dynamic.hs - + compiler/GHC/Linker/Executable.hs - − compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Linker/Windows.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - + compiler/GHC/Runtime/Interpreter/C.hs - + compiler/GHC/Runtime/Interpreter/Init.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - + compiler/GHC/Tc/Gen/App.hs-boot - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/Tc/Types/LclEnv.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/SourceText.hs - compiler/ghc.cabal.in - hadrian/stack.yaml - hadrian/stack.yaml.lock - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Data/List.hs - libraries/base/src/Data/List/NonEmpty.hs - + libraries/base/src/Data/List/NubOrdSet.hs - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs - + testsuite/tests/bytecode/T23973.hs - + testsuite/tests/bytecode/T23973.script - + testsuite/tests/bytecode/T23973.stdout - + testsuite/tests/bytecode/T26565.hs - + testsuite/tests/bytecode/T26565.script - + testsuite/tests/bytecode/T26565.stdout - testsuite/tests/bytecode/all.T - + testsuite/tests/deSugar/should_compile/T10662 - testsuite/tests/default/default-fail05.stderr - + testsuite/tests/driver/T24731.hs - testsuite/tests/driver/all.T - + testsuite/tests/ghci.debugger/Do - + testsuite/tests/ghci.debugger/Do.hs - + testsuite/tests/ghci.debugger/T25996.hs - testsuite/tests/indexed-types/should_fail/T2693.stderr - testsuite/tests/indexed-types/should_fail/T5439.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + testsuite/tests/linear/should_run/T26311.hs - + testsuite/tests/linear/should_run/T26311.stdout - testsuite/tests/linear/should_run/all.T - testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/plugins/test-defaulting-plugin.stderr - testsuite/tests/pmcheck/should_compile/pmcOrPats.stderr - testsuite/tests/polykinds/T13393.stderr - testsuite/tests/printer/T17697.stderr - testsuite/tests/rebindable/rebindable6.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - + testsuite/tests/rep-poly/T26072b.hs - testsuite/tests/rep-poly/all.T - testsuite/tests/simd/should_run/all.T - testsuite/tests/typecheck/should_compile/T14590.stderr - + testsuite/tests/typecheck/should_compile/T25996.hs - + testsuite/tests/typecheck/should_compile/T26582.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/DoExpansion1.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/T10971d.stderr - testsuite/tests/typecheck/should_fail/T13311.stderr - + testsuite/tests/typecheck/should_fail/T25970.hs - + testsuite/tests/typecheck/should_fail/T25996.hs - testsuite/tests/typecheck/should_fail/T3323.stderr - testsuite/tests/typecheck/should_fail/T3613.stderr - testsuite/tests/typecheck/should_fail/T6069.stderr - testsuite/tests/typecheck/should_fail/T7851.stderr - testsuite/tests/typecheck/should_fail/T8603.stderr - testsuite/tests/typecheck/should_fail/T9612.stderr - testsuite/tests/typecheck/should_fail/tcfail102.stderr - testsuite/tests/typecheck/should_fail/tcfail128.stderr - testsuite/tests/typecheck/should_fail/tcfail140.stderr - testsuite/tests/typecheck/should_fail/tcfail181.stderr - utils/haddock/haddock-test/src/Test/Haddock.hs - utils/iserv/iserv.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/564a394730f7642f4091d2f7a57fe6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/564a394730f7642f4091d2f7a57fe6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/amg/castz] 3 commits: Remove castCoToCo calls from collectBindersPushingCo
by Adam Gundry (＠adamgundry) 22 Nov '25

22 Nov '25

Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC Commits: f56deed3 by Adam Gundry at 2025-11-21T16:15:28+00:00 Remove castCoToCo calls from collectBindersPushingCo - - - - - c49a9fc0 by Adam Gundry at 2025-11-22T20:47:54+00:00 Pass type argument to castCoercionRKind - - - - - 43867efa by Adam Gundry at 2025-11-22T21:05:08+00:00 Add ReflCastCo - - - - - 22 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -2452,6 +2452,7 @@ seqMCo (MCo co) = seqCo co seqCastCoercion :: CastCoercion -> () seqCastCoercion (CCoercion co) = seqCo co seqCastCoercion (ZCoercion ty cos) = seqType ty `seq` seqVarSet cos +seqCastCoercion ReflCastCo = () seqCo :: Coercion -> () seqCo (Refl ty) = seqType ty @@ -2874,45 +2875,56 @@ See Note [Zapped casts] in GHC.Core.TyCo.Rep. castCoercionLKind :: HasDebugCallStack => Type -> CastCoercion -> Type castCoercionLKind _ (CCoercion co) = coercionLKind co castCoercionLKind lhs_ty (ZCoercion _ _) = lhs_ty +castCoercionLKind lhs_ty ReflCastCo = lhs_ty -- | Compute the right type of a 'CastCoercion', like 'coercionRKind'. -castCoercionRKind :: HasDebugCallStack => CastCoercion -> Type -castCoercionRKind (CCoercion co) = coercionRKind co -castCoercionRKind (ZCoercion ty _) = ty +-- Corresponds to 'coercionRKind', but requires the type to be supplied by the +-- caller because it cannot be recovered in the 'ReflCastCo' case. +castCoercionRKind :: HasDebugCallStack => Type -> CastCoercion -> Type +castCoercionRKind _ (CCoercion co) = coercionRKind co +castCoercionRKind _ (ZCoercion rhs_ty _) = rhs_ty +castCoercionRKind lhs_ty ReflCastCo = lhs_ty -- | Equality test on 'CastCoercion', where the LHS type is the same for both -- coercions, so we merely need to compare the RHS types. -eqCastCoercion :: CastCoercion -> CastCoercion -> Bool -eqCastCoercion cco1 cco2 = castCoercionRKind cco1 `eqType` castCoercionRKind cco2 +eqCastCoercion :: Type -> CastCoercion -> CastCoercion -> Bool +eqCastCoercion _ ReflCastCo ReflCastCo = True +eqCastCoercion lhs_ty cco1 cco2 = castCoercionRKind lhs_ty cco1 `eqType` castCoercionRKind lhs_ty cco2 -eqCastCoercionX :: RnEnv2 -> CastCoercion -> CastCoercion -> Bool -eqCastCoercionX env = eqTypeX env `on` castCoercionRKind +eqCastCoercionX :: RnEnv2 -> Type -> CastCoercion -> Type -> CastCoercion -> Bool +eqCastCoercionX _ _ ReflCastCo _ ReflCastCo = True +eqCastCoercionX env ty1 co1 ty2 co2 = eqTypeX env ty1 ty2 + && eqTypeX env (castCoercionRKind ty1 co1) (castCoercionRKind ty2 co2) -- | Convert a 'CastCoercion' back into a 'Coercion', using a 'UnivCo' if we -- have discarded the original 'Coercion'. castCoToCo :: Type -> CastCoercion -> CoercionR castCoToCo _ (CCoercion co) = co castCoToCo lhs_ty (ZCoercion rhs_ty cos) = mkUnivCo ZCoercionProv (map CoVarCo (nonDetEltsUniqSet cos)) Representational lhs_ty rhs_ty +castCoToCo lhs_ty ReflCastCo = mkRepReflCo lhs_ty -- | Compose two 'CastCoercion's transitively, like 'mkTransCo'. If either is -- zapped the whole result will be zapped. mkTransCastCo :: HasDebugCallStack => CastCoercion -> CastCoercion -> CastCoercion mkTransCastCo cco (CCoercion co) = mkTransCastCoCo cco co mkTransCastCo cco (ZCoercion ty cos) = ZCoercion ty (shallowCoVarsOfCastCo cco `unionVarSet` cos) +mkTransCastCo cco ReflCastCo = cco -- | Transitively compose a 'CastCoercion' followed by a 'Coercion'. mkTransCastCoCo :: HasDebugCallStack => CastCoercion -> Coercion -> CastCoercion mkTransCastCoCo (CCoercion co1) co2 = CCoercion (mkTransCo co1 co2) mkTransCastCoCo (ZCoercion _ cos) co2 = ZCoercion (coercionRKind co2) (shallowCoVarsOfCo co2 `unionVarSet` cos) +mkTransCastCoCo ReflCastCo co2 = CCoercion co2 -- | Transitively compose a 'Coercion' followed by a 'CastCoercion'. mkTransCoCastCo :: HasDebugCallStack => Coercion -> CastCoercion -> CastCoercion mkTransCoCastCo co1 (CCoercion co2) = CCoercion (mkTransCo co1 co2) mkTransCoCastCo co1 (ZCoercion ty cos) = ZCoercion ty (shallowCoVarsOfCo co1 `unionVarSet` cos) +mkTransCoCastCo co1 ReflCastCo = CCoercion co1 -- | Slowly checks if the coercion is reflexive. Don't call this in a loop, -- as it walks over the entire coercion. isReflexiveCastCo :: Type -> CastCoercion -> Bool isReflexiveCastCo _ (CCoercion co) = isReflexiveCo co isReflexiveCastCo lhs_ty (ZCoercion rhs_ty _) = lhs_ty `eqType` rhs_ty - +isReflexiveCastCo _ ReflCastCo = True ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -280,6 +280,7 @@ exprFVs (Let (Rec pairs) body) fv_cand in_scope acc cast_co_fvs :: CastCoercion -> FV cast_co_fvs (CCoercion co) fv_cand in_scope acc = (tyCoFVsOfCo co) fv_cand in_scope acc cast_co_fvs (ZCoercion ty cos) fv_cand in_scope acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfCoVarSet cos) fv_cand in_scope acc +cast_co_fvs ReflCastCo _ _ acc = acc --------- rhs_fvs :: (Id, CoreExpr) -> FV ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -30,7 +30,9 @@ import GHC.Prelude import GHC.Data.TrieMap import GHC.Core.Map.Type import GHC.Core +import GHC.Core.Coercion import GHC.Core.Type +import GHC.Core.Utils import GHC.Types.Tickish import GHC.Types.Var @@ -159,7 +161,7 @@ eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where go (Type t1) (Type t2) = eqDeBruijnType (D env1 t1) (D env2 t2) -- See Note [Alpha-equality for Coercion arguments] go (Coercion {}) (Coercion {}) = True - go (Cast e1 co1) (Cast e2 co2) = D env1 co1 == D env2 co2 && go e1 e2 + go (Cast e1 co1) (Cast e2 co2) = D env1 (castCoercionRKind (exprType e1) co1) == D env2 (castCoercionRKind (exprType e2) co2) && go e1 e2 go (App f1 a1) (App f2 a2) = go f1 f2 && go a1 a2 go (Tick n1 e1) (Tick n2 e2) = eqDeBruijnTickish (D env1 n1) (D env2 n2) @@ -343,7 +345,7 @@ lkE (D env expr) cm = go expr cm go (Lit l) = cm_lit >.> lookupTM l go (Type t) = cm_type >.> lkG (D env t) go (Coercion c) = cm_co >.> lkG (D env c) - go (Cast e c) = cm_cast >.> lkG (D env e) >=> lkG (D env c) + go (Cast e c) = cm_cast >.> lkG (D env e) >=> lkG (D env (castCoercionRKind (exprType e) c)) go (Tick tickish e) = cm_tick >.> lkG (D env e) >=> lkTickish tickish go (App e1 e2) = cm_app >.> lkG (D env e2) >=> lkG (D env e1) go (Lam v e) = cm_lam >.> lkG (D (extendCME env v) e) @@ -370,7 +372,7 @@ xtE (D env (Coercion c)) f m = m { cm_co = cm_co m |> xtG (D env c) f } xtE (D _ (Lit l)) f m = m { cm_lit = cm_lit m |> alterTM l f } xtE (D env (Cast e c)) f m = m { cm_cast = cm_cast m |> xtG (D env e) - |>> xtG (D env c) f } + |>> xtG (D env (castCoercionRKind (exprType e) c)) f } xtE (D env (Tick t e)) f m = m { cm_tick = cm_tick m |> xtG (D env e) |>> xtTickish t f } xtE (D env (App e1 e2)) f m = m { cm_app = cm_app m |> xtG (D env e2) ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -147,7 +147,7 @@ instance Functor CastCoercionMap where {-# INLINE fmap #-} instance TrieMap CastCoercionMap where - type Key CastCoercionMap = CastCoercion + type Key CastCoercionMap = Type emptyTM = CastCoercionMap emptyTM lookupTM k (CastCoercionMap m) = lookupTM (deBruijnize k) m alterTM k f (CastCoercionMap m) = CastCoercionMap (alterTM (deBruijnize k) f m) @@ -164,7 +164,7 @@ instance Functor CastCoercionMapX where {-# INLINE fmap #-} instance TrieMap CastCoercionMapX where - type Key CastCoercionMapX = DeBruijn CastCoercion + type Key CastCoercionMapX = DeBruijn Type emptyTM = CastCoercionMapX emptyTM lookupTM = lkX alterTM = xtX @@ -172,18 +172,12 @@ instance TrieMap CastCoercionMapX where filterTM f (CastCoercionMapX core_tm) = CastCoercionMapX (filterTM f core_tm) mapMaybeTM f (CastCoercionMapX core_tm) = CastCoercionMapX (mapMaybeTM f core_tm) -instance Eq (DeBruijn CastCoercion) where - D env1 co1 == D env2 co2 - = D env1 (castCoercionRKind co1) == - D env2 (castCoercionRKind co2) - -lkX :: DeBruijn CastCoercion -> CastCoercionMapX a -> Maybe a -lkX (D env co) (CastCoercionMapX core_tm) = lkT (D env $ castCoercionRKind co) - core_tm +lkX :: DeBruijn Type -> CastCoercionMapX a -> Maybe a +lkX (D env co_ty) (CastCoercionMapX core_tm) = lkT (D env co_ty) core_tm -xtX :: DeBruijn CastCoercion -> XT a -> CastCoercionMapX a -> CastCoercionMapX a -xtX (D env co) f (CastCoercionMapX m) - = CastCoercionMapX (xtT (D env $ castCoercionRKind co) f m) +xtX :: DeBruijn Type -> XT a -> CastCoercionMapX a -> CastCoercionMapX a +xtX (D env co_ty) f (CastCoercionMapX m) + = CastCoercionMapX (xtT (D env co_ty) f m) {- ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3119,27 +3119,28 @@ collectBindersPushingCo e go :: [Var] -> CoreExpr -> ([Var], CoreExpr) -- The accumulator is in reverse order go bs (Lam b e) = go (b:bs) e - go bs (Cast e co) = go_c bs e (castCoToCo (exprType e) co) -- TODO: can we do better? + go bs (Cast e co) = go_c bs e co go bs e = (reverse bs, e) -- We are in a cast; peel off casts until we hit a lambda. - go_c :: [Var] -> CoreExpr -> Coercion -> ([Var], CoreExpr) + go_c :: [Var] -> CoreExpr -> CastCoercion -> ([Var], CoreExpr) -- (go_c bs e c) is same as (go bs e (e |> c)) - go_c bs (Cast e co1) co2 = go_c bs e (castCoToCo (exprType e) co1 `mkTransCo` co2) -- TODO: can we do better? + go_c bs (Cast e co1) co2 = go_c bs e (co1 `mkTransCastCo` co2) go_c bs (Lam b e) co = go_lam bs b e co - go_c bs e co = (reverse bs, mkCast e co) + go_c bs e co = (reverse bs, mkCastCo e co) -- We are in a lambda under a cast; peel off lambdas and build a -- new coercion for the body. - go_lam :: [Var] -> Var -> CoreExpr -> CoercionR -> ([Var], CoreExpr) + go_lam :: [Var] -> Var -> CoreExpr -> CastCoercion -> ([Var], CoreExpr) -- (go_lam bs b e c) is same as (go_c bs (\b.e) c) - go_lam bs b e co + -- TODO: does it matter that ZCoercion will not do any of this? + go_lam bs b e (CCoercion co) | isTyVar b , let Pair tyL tyR = coercionKind co , assert (isForAllTy_ty tyL) $ isForAllTy_ty tyR , isReflCo (mkSelCo SelForAll co) -- See Note [collectBindersPushingCo] - = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b))) + = go_c (b:bs) e (CCoercion (mkInstCo co (mkNomReflCo (mkTyVarTy b)))) | isCoVar b , let Pair tyL tyR = coercionKind co @@ -3147,7 +3148,7 @@ collectBindersPushingCo e isForAllTy_co tyR , isReflCo (mkSelCo SelForAll co) -- See Note [collectBindersPushingCo] , let cov = mkCoVarCo b - = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov))) + = go_c (b:bs) e (CCoercion (mkInstCo co (mkNomReflCo (mkCoercionTy cov)))) | isId b , let Pair tyL tyR = coercionKind co @@ -3155,9 +3156,9 @@ collectBindersPushingCo e , (co_mult, co_arg, co_res) <- decomposeFunCo co , isReflCo co_mult -- See Note [collectBindersPushingCo] , isReflCo co_arg -- See Note [collectBindersPushingCo] - = go_c (b:bs) e co_res + = go_c (b:bs) e (CCoercion co_res) - | otherwise = (reverse bs, mkCast (Lam b e) co) + go_lam bs b e cco = (reverse bs, mkCastCo (Lam b e) cco) {- Note [collectBindersPushingCo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -224,9 +224,9 @@ cprAnal' env (Cast e co) where (cpr_ty, e') = cprAnal env e cpr_ty' - | cpr_ty == topCprType = topCprType -- cheap case first - | isRecNewTyConApp env (castCoercionRKind co) = topCprType -- See Note [CPR for recursive data constructors] - | otherwise = cpr_ty + | cpr_ty == topCprType = topCprType -- cheap case first + | isRecNewTyConApp env (castCoercionRKind (exprType e) co) = topCprType -- See Note [CPR for recursive data constructors] + | otherwise = cpr_ty cprAnal' env (Tick t e) = (cpr_ty, Tick t e') ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -2331,6 +2331,7 @@ coercionDmdEnv co = coercionsDmdEnv [co] castCoercionDmdEnv :: CastCoercion -> DmdEnv castCoercionDmdEnv (CCoercion co) = coercionDmdEnv co castCoercionDmdEnv (ZCoercion _ cos) = coVarSetDmdEnv cos +castCoercionDmdEnv ReflCastCo = nopDmdEnv coercionsDmdEnv :: [Coercion] -> DmdEnv coercionsDmdEnv cos ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -2693,7 +2693,7 @@ argToPat1 env in_scope val_env (Cast arg co) arg_occ arg_str else return (interesting, Cast arg' co, strict_args) } where - ty2 = castCoercionRKind co + ty2 = castCoercionRKind (exprType arg) co -- Check for a constructor application -- NB: this *precedes* the Var case, so that we catch nullary constrs ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -173,6 +173,7 @@ noParens pp = pp pprOptCastCoercion :: CastCoercion -> SDoc pprOptCastCoercion (CCoercion co) = pprOptCo co pprOptCastCoercion (ZCoercion ty cos) = pprOptZappedCo ty cos +pprOptCastCoercion ReflCastCo = text "ReflCastCo" pprOptZappedCo :: Type -> CoVarSet -> SDoc pprOptZappedCo ty cos = sdocOption sdocSuppressCoercions $ \case ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -316,6 +316,7 @@ runTyCoVars f = appEndoOS f emptyVarSet tyCoVarsOfCastCo :: CastCoercion -> TyCoVarSet tyCoVarsOfCastCo (CCoercion co) = coVarsOfCo co tyCoVarsOfCastCo (ZCoercion ty cos) = tyCoVarsOfType ty `unionVarSet` cos +tyCoVarsOfCastCo ReflCastCo = emptyVarSet tyCoVarsOfType :: Type -> TyCoVarSet -- The "deep" TyCoVars of the the type @@ -441,6 +442,7 @@ shallowCoVarsOfType ty = filterVarSet isCoVar $ shallowTyCoVarsOfType ty shallowCoVarsOfCastCo :: CastCoercion -> CoVarSet shallowCoVarsOfCastCo (CCoercion co) = shallowCoVarsOfCo co shallowCoVarsOfCastCo (ZCoercion ty cos) = shallowCoVarsOfType ty `unionVarSet` cos +shallowCoVarsOfCastCo ReflCastCo = emptyVarSet {- ********************************************************************* @@ -468,6 +470,7 @@ See #14880. coVarsOfCastCo :: CastCoercion -> CoVarSet coVarsOfCastCo (CCoercion co) = coVarsOfCo co coVarsOfCastCo (ZCoercion ty cos) = coVarsOfType ty `unionVarSet` cos -- TODO cos doesn't include deep, this isn't enough? +coVarsOfCastCo ReflCastCo = emptyVarSet -- See Note [Finding free coercion variables] coVarsOfType :: Type -> CoVarSet @@ -705,6 +708,7 @@ tyCoFVsOfMCo mco fv_cand in_scope acc tyCoFVsOfCastCoercion :: CastCoercion -> FV tyCoFVsOfCastCoercion (CCoercion co) = tyCoFVsOfCo co tyCoFVsOfCastCoercion (ZCoercion ty cos) = tyCoFVsOfType ty `unionFV` tyCoFVsOfCoVarSet cos +tyCoFVsOfCastCoercion ReflCastCo = mempty tyCoFVsOfCoVarSet :: CoVarSet -> FV tyCoFVsOfCoVarSet = nonDetStrictFoldVarSet (unionFV . tyCoFVsOfCoVar) emptyFV -- TODO better way? Nondeterminism? ===================================== compiler/GHC/Core/TyCo/Ppr.hs ===================================== @@ -142,6 +142,7 @@ pprCastCo co = getPprStyle $ \ sty -> pprIfaceCastCoercion (tidyToIfaceCastCoSty tidyToIfaceCastCoSty :: CastCoercion -> PprStyle -> IfaceCastCoercion tidyToIfaceCastCoSty (CCoercion co) sty = IfaceCCoercion (tidyToIfaceCoSty co sty) tidyToIfaceCastCoSty (ZCoercion ty cos) sty = IfaceZCoercion (tidyToIfaceType ty) (map (flip tidyToIfaceCoSty sty . CoVarCo) (nonDetEltsUniqSet cos)) -- TODO +tidyToIfaceCastCoSty ReflCastCo _ = IfaceReflCastCo tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion tidyToIfaceCoSty co sty ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -904,7 +904,7 @@ type KindMCoercion = MCoercionN -- See Note [KindCoercion] data CastCoercion = CCoercion CoercionR -- Not zapped; the Coercion has Representational role | ZCoercion Type CoVarSet -- Zapped; stores only the RHS type and free CoVars - -- | ReflCastCo -- TODO + | ReflCastCo deriving Data.Data -- | A 'Coercion' is concrete evidence of the equality/convertibility @@ -2143,6 +2143,7 @@ typesSize tys = foldr ((+) . typeSize) 0 tys castCoercionSize :: CastCoercion -> Int castCoercionSize (CCoercion co) = coercionSize co castCoercionSize (ZCoercion ty cos) = typeSize ty + sizeVarSet cos +castCoercionSize ReflCastCo = 1 coercionSize :: Coercion -> Int coercionSize (Refl ty) = typeSize ty ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -837,6 +837,7 @@ lookupTyVar (Subst _ _ tenv _) tv substCastCo :: HasDebugCallStack => Subst -> CastCoercion -> CastCoercion substCastCo subst (CCoercion co) = CCoercion (substCo subst co) substCastCo subst (ZCoercion ty cos) = ZCoercion (substTy subst ty) (substCoVarSet subst cos) +substCastCo _ ReflCastCo = ReflCastCo substCoVarSet :: HasDebugCallStack => Subst -> CoVarSet -> CoVarSet substCoVarSet subst = nonDetStrictFoldVarSet (unionVarSet . shallowCoVarsOfCo . substCoVar subst) emptyVarSet -- TODO better impl; determinism? ===================================== compiler/GHC/Core/TyCo/Tidy.hs ===================================== @@ -366,5 +366,6 @@ tidyCos :: TidyEnv -> [Coercion] -> [Coercion] tidyCos env = strictMap (tidyCo env) tidyCastCo :: TidyEnv -> CastCoercion -> CastCoercion -tidyCastCo env (CCoercion co) = CCoercion (tidyCo env co) +tidyCastCo env (CCoercion co) = CCoercion (tidyCo env co) tidyCastCo env (ZCoercion ty cos) = ZCoercion (tidyType env ty) (mapVarSet (tidyTyCoVarOcc env) cos) +tidyCastCo _ ReflCastCo = ReflCastCo ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -141,7 +141,7 @@ exprType (Let bind body) , Type ty <- rhs = substTyWithUnchecked [tv] [ty] (exprType body) | otherwise = exprType body exprType (Case _ _ ty _) = ty -exprType (Cast _ co) = castCoercionRKind co +exprType (Cast e co) = castCoercionRKind (exprType e) co exprType (Tick _ e) = exprType e exprType (Lam binder expr) = mkLamType binder (exprType expr) exprType e@(App _ _) @@ -271,6 +271,7 @@ mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) mkCastCo :: HasDebugCallStack => CoreExpr -> CastCoercion -> CoreExpr mkCastCo expr (CCoercion co) = mkCast expr co mkCastCo expr (ZCoercion ty cos) = mkCastZ expr ty cos +mkCastCo expr ReflCastCo = expr -- | Wrap the given expression in the coercion safely, dropping -- identity coercions and coalescing nested coercions @@ -2512,11 +2513,11 @@ c.f. add_evals in GHC.Core.Opt.Simplify.simplAlt -- | A cheap equality test which bales out fast! -- If it returns @True@ the arguments are definitely equal, -- otherwise, they may or may not be equal. -cheapEqExpr :: Expr b -> Expr b -> Bool +cheapEqExpr :: CoreExpr -> CoreExpr -> Bool cheapEqExpr = cheapEqExpr' (const False) -- | Cheap expression equality test, can ignore ticks by type. -cheapEqExpr' :: (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool +cheapEqExpr' :: (CoreTickish -> Bool) -> CoreExpr -> CoreExpr -> Bool {-# INLINE cheapEqExpr' #-} cheapEqExpr' ignoreTick e1 e2 = go e1 e2 @@ -2526,7 +2527,7 @@ cheapEqExpr' ignoreTick e1 e2 go (Type t1) (Type t2) = t1 `eqType` t2 go (Coercion c1) (Coercion c2) = c1 `eqCoercion` c2 go (App f1 a1) (App f2 a2) = f1 `go` f2 && a1 `go` a2 - go (Cast e1 co1) (Cast e2 co2) = e1 `go` e2 && eqCastCoercion co1 co2 + go (Cast e1 co1) (Cast e2 co2) = e1 `go` e2 && eqCastCoercion (exprType e1) co1 co2 go (Tick t1 e1) e2 | ignoreTick t1 = go e1 e2 go e1 (Tick t2 e2) | ignoreTick t2 = go e1 e2 @@ -2622,7 +2623,7 @@ diffExpr _ env (Type t1) (Type t2) | eqTypeX env t1 t2 = [] diffExpr _ env (Coercion co1) (Coercion co2) | eqCoercionX env co1 co2 = [] diffExpr top env (Cast e1 co1) (Cast e2 co2) - | eqCastCoercionX env co1 co2 = diffExpr top env e1 e2 + | eqCastCoercionX env (exprType e1) co1 (exprType e2) co2 = diffExpr top env e1 e2 diffExpr top env (Tick n1 e1) e2 | not (tickishIsCode n1) = diffExpr top env e1 e2 diffExpr top env e1 (Tick n2 e2) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -273,6 +273,7 @@ toIfaceTyLit (CharTyLit x) = IfaceCharTyLit x toIfaceCastCoercion :: CastCoercion -> IfaceCastCoercion toIfaceCastCoercion (CCoercion co) = IfaceCCoercion (toIfaceCoercion co) toIfaceCastCoercion (ZCoercion ty cos) = IfaceZCoercion (toIfaceType ty) (map (toIfaceCoercion . CoVarCo) (nonDetEltsUniqSet cos)) -- TODO determinism +toIfaceCastCoercion ReflCastCo = IfaceReflCastCo toIfaceCoercion :: Coercion -> IfaceCoercion toIfaceCoercion = toIfaceCoercionX emptyVarSet ===================================== compiler/GHC/Iface/Rename.hs ===================================== @@ -888,8 +888,9 @@ rnIfaceMCo IfaceMRefl = pure IfaceMRefl rnIfaceMCo (IfaceMCo co) = IfaceMCo <$> rnIfaceCo co rnIfaceCastCo :: Rename IfaceCastCoercion -rnIfaceCastCo (IfaceCCoercion co) = IfaceCCoercion <$> rnIfaceCo co +rnIfaceCastCo (IfaceCCoercion co) = IfaceCCoercion <$> rnIfaceCo co rnIfaceCastCo (IfaceZCoercion ty cos) = IfaceZCoercion <$> rnIfaceType ty <*> mapM rnIfaceCo cos +rnIfaceCastCo IfaceReflCastCo = pure IfaceReflCastCo rnIfaceCo :: Rename IfaceCoercion rnIfaceCo (IfaceReflCo ty) = IfaceReflCo <$> rnIfaceType ty ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -2075,8 +2075,9 @@ freeNamesIfMCoercion IfaceMRefl = emptyNameSet freeNamesIfMCoercion (IfaceMCo co) = freeNamesIfCoercion co freeNamesIfCastCoercion :: IfaceCastCoercion -> NameSet -freeNamesIfCastCoercion (IfaceCCoercion co) = freeNamesIfCoercion co +freeNamesIfCastCoercion (IfaceCCoercion co) = freeNamesIfCoercion co freeNamesIfCastCoercion (IfaceZCoercion ty cos) = freeNamesIfType ty &&& fnList freeNamesIfCoercion cos +freeNamesIfCastCoercion IfaceReflCastCo = emptyNameSet freeNamesIfCoercion :: IfaceCoercion -> NameSet freeNamesIfCoercion (IfaceReflCo t) = freeNamesIfType t ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -480,6 +480,7 @@ data IfaceMCoercion data IfaceCastCoercion = IfaceCCoercion IfaceCoercion | IfaceZCoercion IfaceType [IfaceCoercion] + | IfaceReflCastCo deriving (Eq, Ord) data IfaceCoercion @@ -2040,10 +2041,12 @@ pprIfaceTyLit (IfaceCharTyLit c) = text (show c) pprIfaceCastCoercion :: IfaceCastCoercion -> SDoc pprIfaceCastCoercion (IfaceCCoercion co) = pprIfaceCoercion co pprIfaceCastCoercion (IfaceZCoercion ty cos) = text "Zap" <+> pprParendIfaceType ty <+> ppr cos +pprIfaceCastCoercion IfaceReflCastCo = text "ReflCastCo" pprParendIfaceCastCoercion :: IfaceCastCoercion -> SDoc pprParendIfaceCastCoercion (IfaceCCoercion co) = pprParendIfaceCoercion co pprParendIfaceCastCoercion (IfaceZCoercion ty cos) = parens (pprIfaceCastCoercion (IfaceZCoercion ty cos)) +pprParendIfaceCastCoercion IfaceReflCastCo = text "ReflCastCo" pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc pprIfaceCoercion = ppr_co topPrec @@ -2447,6 +2450,7 @@ instance Binary IfaceCastCoercion where putByte bh 2 put_ bh a put_ bh b + put_ bh IfaceReflCastCo = putByte bh 3 get bh = do tag <- getByte bh @@ -2456,6 +2460,7 @@ instance Binary IfaceCastCoercion where 2 -> do a <- get bh b <- get bh return $ IfaceZCoercion a b + 3 -> return IfaceReflCastCo _ -> panic ("get IfaceCastCoercion " ++ show tag) @@ -2643,6 +2648,7 @@ instance NFData IfaceCastCoercion where rnf = \case IfaceCCoercion f1 -> rnf f1 IfaceZCoercion f1 f2 -> rnf f1 `seq` rnf f2 + IfaceReflCastCo -> () instance NFData IfaceCoercion where rnf = \case ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1582,6 +1582,7 @@ tcIfaceTyLit (IfaceCharTyLit n) = return (CharTyLit n) tcIfaceCastCoercion :: IfaceCastCoercion -> IfL CastCoercion tcIfaceCastCoercion (IfaceCCoercion co) = CCoercion <$> tcIfaceCo co tcIfaceCastCoercion (IfaceZCoercion ty cos) = ZCoercion <$> tcIfaceType ty <*> (shallowCoVarsOfCos <$> mapM tcIfaceCo cos) +tcIfaceCastCoercion IfaceReflCastCo = pure ReflCastCo tcIfaceCo :: IfaceCoercion -> IfL Coercion tcIfaceCo = go ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -649,6 +649,7 @@ optSubTypeHsWrapper wrap CCoercion co -> not (anyFreeVarsOfCo (== v) co) ZCoercion ty cvs -> not (anyFreeVarsOfType (== v) ty) && not (v `elemVarSet` cvs) + ReflCastCo -> True not_in_submult :: TyVar -> SubMultCo -> Bool not_in_submult v = \case ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -551,6 +551,7 @@ _zonkCosToCos :: [Coercion] -> ZonkTcM [Coercion] zonkCastCo :: CastCoercion -> ZonkTcM CastCoercion zonkCastCo (CCoercion co) = CCoercion <$> zonkCoToCo co zonkCastCo (ZCoercion ty cos) = ZCoercion <$> zonkTcTypeToTypeX ty <*> zonkCoVarSet cos +zonkCastCo ReflCastCo = pure ReflCastCo zonkCoVarSet :: CoVarSet -> ZonkTcM CoVarSet zonkCoVarSet = fmap shallowCoVarsOfCos . mapM zonkCoVarOcc . nonDetEltsUniqSet @@ -1868,6 +1869,8 @@ zonkEvTerm (EvCastExpr e (CCoercion co) co_res_ty) } zonkEvTerm ev@(EvCastExpr _ (ZCoercion{}) _) = pprPanic "zonkEvTerm: ZCoercion" (ppr ev) +zonkEvTerm (EvCastExpr e ReflCastCo _) + = EvExpr <$> zonkCoreExpr e zonkEvTerm (EvTypeable ty ev) = EvTypeable <$> zonkTcTypeToTypeX ty <*> zonkEvTypeable ev zonkEvTerm (EvFun { et_tvs = tvs, et_given = evs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df288bc2b2dc5b657cb3ea7ea7cba7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df288bc2b2dc5b657cb3ea7ea7cba7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26579] 36 commits: Preserve user-written kinds in data declarations
by Peter Trommler (＠trommler) 22 Nov '25

22 Nov '25

Peter Trommler pushed to branch wip/T26579 at Glasgow Haskell Compiler / GHC Commits: 3c2f4bb4 by sheaf at 2025-11-11T11:47:28-05:00 Preserve user-written kinds in data declarations This commit ensures that we preserve the user-written kind for data declarations, e.g. in type T2T = Type -> Type type D :: T2T data D a where { .. } that we preserve the user-written kind of D as 'T2T', instead of expanding the type synonym 'T2T' during kind checking. We do this by storing 'tyConKind' separately from 'tyConResKind'. This means that 'tyConKind' is not necessarily equal to 'mkTyConKind binders res_kind', as e.g. in the above example the former is 'T2T' while the latter is 'Type -> Type'. This is explained in Note [Preserve user-written TyCon kind] in GHC.Core.TyCon. This is particularly important for Haddock, as the kinds stored in interface files affect the generated documentation, and we want to preserve the user-written types as much as possible. - - - - - 19859584 by sheaf at 2025-11-11T11:47:28-05:00 Store user-written datacon tvs in interface files This commit ensures we store the user-written quantified type variables of data constructors in interface files, e.g. in data D a where MkD1 :: forall x. x -> D x MkD2 :: forall u v. u -> v -> D v The previous behaviour was to rename the universal variables to match the universal variables of the data constructor. This was undesirable because the names that end up in interface files end up mattering for generated Haddock documentation; it's better to preserve the user-written type variables. Moreover, the universal variables may not have been user-written at all, e.g. in an example such as: type T2T = Type -> Type data G :: T2T where MkG :: forall x. D x Here GHC will invent the type variable name 'a' for the first binder of the TyCon G. We really don't want to then rename the user-written 'x' into the generated 'a'. - - - - - 034b2056 by sheaf at 2025-11-11T11:47:28-05:00 DataCon univ_tvs names: pick TyCon over inferred This commit changes how we compute the names of universal type variables in GADT data constructors. This augments the existing logic that chose which type variable name to use, in GHC.Tc.TyCl.mkGADTVars. We continue to prefer DataCon tv names for user-written binders, but we now prefer TyCon tv names for inferred (non-user-written) DataCon binders. This makes a difference in examples such as: type (:~~:) :: k1 -> k2 -> Type data a :~~: b where HRefl :: a :~~: a Before this patch, we ended up giving HRefl the type: forall {k2}. forall (a :: k2). a :~~: a whereas we now give it the type: forall {k1}. forall (a :: k1). a :~~: a The important part isn't really 'k1' or 'k2', but more that the inferred type variable names of the DataCon can be arbitrary/unpredictable (as they are chosen by GHC and depend on how unification proceeds), so it's much better to use the more predictable TyCon type variable names. - - - - - 95078d00 by sheaf at 2025-11-11T11:47:28-05:00 Backpack Rename: use explicit record construction This commit updates the Backpack boilerplate in GHC.Iface.Rename to use explicit record construction rather than record update. This makes sure that the code stays up to date when the underlying constructors change (e.g. new fields are added). The rationale is further explained in Note [Prefer explicit record construction]. - - - - - 2bf36263 by sheaf at 2025-11-11T11:47:28-05:00 Store # eta binders in TyCon and use for Haddock This commit stores the number of TyCon binders that were introduced by eta-expansion (by the function GHC.Tc.Gen.HsType.splitTyConKind). This is then used to pretty-print the TyCon as the user wrote it, e.g. for type Effect :: (Type -> Type) -> Type -> Type data State s :: Effect where {..} -- arity 3 GHC will eta-expand the data declaration to data State s a b where {..} but also store in the 'TyCon' that the number of binders introduced by this eta expansion is 2. This allows us, in 'Haddock.Convert.synifyTyConKindSig', to recover the original user-written syntax, preserving the user's intent in Haddock documentation. See Note [Inline kind signatures with GADTSyntax] in Haddock.Convert. - - - - - 6c91582f by Matthew Pickering at 2025-11-11T11:48:12-05:00 driver: Properly handle errors during LinkNode steps Previously we were not properly catching errors during the LinkNode step (see T9930fail test). This is fixed by wrapping the `LinkNode` action in `wrapAction`, the same handler which is used for module compilation. Fixes #26496 - - - - - e1e1eb32 by Matthew Pickering at 2025-11-11T11:48:54-05:00 driver: Remove unecessary call to hscInsertHPT This call was left-over from e9445c013fbccf9318739ca3d095a3e0a2e1be8a If you follow the functions which call `upsweep_mod`, they immediately add the interface to the HomePackageTable when `upsweep_mod` returns. - - - - - b22777d4 by ARATA Mizuki at 2025-11-11T11:49:44-05:00 LLVM backend: Pass the +evex512 attribute to LLVM 18+ if -mavx512f is set The newer LLVM requires the +evex512 attribute to enable use of ZMM registers. LLVM exhibits a backward-compatible behavior if the cpu is `x86-64`, but not if `penryn`. Therefore, on macOS, where the cpu is set to `penryn`, we need to explicitly pass +evex512. Fixes #26410 - - - - - 6ead7d06 by Vladislav Zavialov at 2025-11-11T11:50:26-05:00 Comments only in GHC.Parser.PostProcess.Haddock Remove outdated Note [Register keyword location], as the issue it describes was addressed by commit 05eb50dff2fcc78d025e77b9418ddb369db49b9f. - - - - - 43fa8be8 by sheaf at 2025-11-11T11:51:18-05:00 localRegistersConflict: account for assignment LHS This commit fixes a serious oversight in GHC.Cmm.Sink.conflicts, specifically the code that computes which local registers conflict between an assignment and a Cmm statement. If we have: assignment: <local_reg> = <expr> node: <local_reg> = <other_expr> then clearly the two conflict, because we cannot move one statement past the other, as they assign two different values to the same local register. (Recall that 'conflicts (local_reg,expr) node' is False if and only if the assignment 'local_reg = expr' can be safely commuted past the statement 'node'.) The fix is to update 'GHC.Cmm.Sink.localRegistersConflict' to take into account the following two situations: (1) 'node' defines the LHS local register of the assignment, (2) 'node' defines a local register used in the RHS of the assignment. The bug is precisely that we were previously missing condition (1). Fixes #26550 - - - - - 79dfcfe0 by sheaf at 2025-11-11T11:51:18-05:00 Update assigned register format when spilling When we come to spilling a register to put new data into it, in GHC.CmmToAsm.Reg.Linear.allocRegsAndSpill_spill, we need to: 1. Spill the data currently in the register. That is, do a spill with a format that matches what's currently in the register. 2. Update the register assignment, allocating a virtual register to this real register, but crucially **updating the format** of this assignment. Due to shadowing in the Haskell code for allocRegsAndSpill_spill, we were mistakenly re-using the old format. This could lead to a situation where: a. We were using xmm6 to store a Double#. b. We want to store a DoubleX2# into xmm6, so we spill the current content of xmm6 to the stack using a scalar move (correct). c. We update the register assignment, but we fail to update the format of the assignment, so we continue to think that xmm6 stores a Double# and not a DoubleX2#. d. Later on, we need to spill xmm6 because it is getting clobbered by another instruction. We then decide to only spill the lower 64 bits of the register, because we still think that xmm6 only stores a Double# and not a DoubleX2#. Fixes #26542 - - - - - aada5db9 by ARATA Mizuki at 2025-11-11T11:52:07-05:00 Fix the order of spill/reload instructions The AArch64 NCG could emit multiple instructions for a single spill/reload, but their order was not consistent between the definition and a use. Fixes #26537 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - 64ec82ff by Andreas Klebinger at 2025-11-11T11:52:48-05:00 Add hpc to release script - - - - - 741da00c by Ben Gamari at 2025-11-12T03:38:20-05:00 template-haskell: Better describe getQ semantics Clarify that the state is a type-indexed map, as suggested by #26484. - - - - - 8b080e04 by ARATA Mizuki at 2025-11-12T03:39:11-05:00 Fix incorrect markups in the User's Guide * Correct markup for C--: "C-\-" in reST * Fix internal links * Fix code highlighting * Fix inline code: Use ``code`` rather than `code` * Remove extra backslashes Fixes #16812 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - a00840ea by Simon Peyton Jones at 2025-11-14T15:23:56+00:00 Make TYPE and CONSTRAINT apart again This patch finally fixes #24279. * The story started with #11715 * Then #21623 articulated a plan, which made Type and Constraint not-apart; a horrible hack but it worked. The main patch was commit 778c6adca2c995cd8a1b84394d4d5ca26b915dac Author: Simon Peyton Jones <simonpj(a)microsoft.com> Date: Wed Nov 9 10:33:22 2022 +0000 Type vs Constraint: finally nailed * #24279 reported a bug in the above big commit; this small patch fixes it commit af6932d6c068361c6ae300d52e72fbe13f8e1f18 Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Mon Jan 8 10:49:49 2024 +0000 Make TYPE and CONSTRAINT not-apart Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty which is supposed to make TYPE and CONSTRAINT be not-apart. * Then !10479 implemented "unary classes". * That change in turn allows us to make Type and Constraint apart again, cleaning up the compiler and allowing a little bit more expressiveness. It fixes the original hope in #24279, namely that `Type` and `Constraint` should be distinct throughout. - - - - - c0a1e574 by Georgios Karachalias at 2025-11-15T05:14:31-05:00 Report all missing modules with -M We now report all missing modules at once in GHC.Driver.Makefile.processDeps, as opposed to only reporting a single missing module. Fixes #26551. - - - - - c9fa3449 by Sylvain Henry at 2025-11-15T05:15:26-05:00 JS: fix array index for registers We used to store R32 in h$regs[-1]. While it's correct in JavaScript, fix this to store R32 in h$regs[0] instead. - - - - - 9e469909 by Sylvain Henry at 2025-11-15T05:15:26-05:00 JS: support more than 128 registers (#26558) The JS backend only supported 128 registers (JS variables/array slots used to pass function arguments). It failed in T26537 when 129 registers were required. This commit adds support for more than 128 registers: it is now limited to maxBound :: Int (compiler's Int). If we ever go above this threshold the compiler now panics with a more descriptive message. A few built-in JS functions were assuming 128 registers and have been rewritten to use loops. Note that loops are only used for "high" registers that are stored in an array: the 31 "low" registers are still handled with JS global variables and with explicit switch-cases to maintain good performance in the most common cases (i.e. few registers used). Adjusting the number of low registers is now easy: just one constant to adjust (GHC.StgToJS.Regs.lowRegsCount). No new test added: T26537 is used as a regression test instead. - - - - - 0a64a78b by Sven Tennie at 2025-11-15T20:31:10-05:00 AArch64: Simplify CmmAssign and CmmStore The special handling for floats was fake: The general case is always used. So, the additional code path isn't needed (and only adds complexity for the reader.) - - - - - 15b311be by sheaf at 2025-11-15T20:32:02-05:00 SimpleOpt: refactor & push coercions into lambdas This commit improves the simple optimiser (in GHC.Core.SimpleOpt) in a couple of ways: - The logic to push coercion lambdas is shored up. The function 'pushCoercionIntoLambda' used to be called in 'finish_app', but this meant we could not continue to optimise the program after performing this transformation. Now, we call 'pushCoercionIntoLambda' as part of 'simple_app'. Doing so can be important when dealing with unlifted newtypes, as explained in Note [Desugaring unlifted newtypes]. - The code is re-structured to avoid duplication and out-of-sync code paths. Now, 'simple_opt_expr' defers to 'simple_app' for the 'App', 'Var', 'Cast' and 'Lam' cases. This means all the logic for those is centralised in a single place (e.g. the 'go_lam' helper function). To do this, the general structure is brought a bit closer to the full-blown simplifier, with a notion of 'continuation' (see 'SimpleContItem'). This commit also modifies GHC.Core.Opt.Arity.pushCoercionIntoLambda to apply a substitution (a slight generalisation of its existing implementation). - - - - - b33284c7 by sheaf at 2025-11-15T20:32:02-05:00 Improve typechecking of data constructors This commit changes the way in which we perform typecheck data constructors, in particular how we make multiplicities line up. Now, impedance matching occurs as part of the existing subsumption machinery. See the revamped Note [Typechecking data constructors] in GHC.Tc.Gen.App, as well as Note [Polymorphisation of linear fields] in GHC.Core.Multiplicity. This allows us to get rid of a fair amount of hacky code that was added with the introduction of LinearTypes; in particular the logic of GHC.Tc.Gen.Head.tcInferDataCon. ------------------------- Metric Decrease: T10421 T14766 T15164 T15703 T19695 T5642 T9630 WWRec ------------------------- - - - - - b6faf5d0 by sheaf at 2025-11-15T20:32:02-05:00 Handle unsaturated rep-poly newtypes This commit allows GHC to handle unsaturated occurrences of unlifted newtype constructors. The plan is detailed in Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Utils.Concrete: for unsaturated unlifted newtypes, we perform the appropriate representation-polymorphism check in tcInstFun. - - - - - 682bf979 by Mike Pilgrem at 2025-11-16T16:44:14+00:00 Fix #26293 Valid stack.yaml for hadrian - - - - - acc70c3a by Simon Peyton Jones at 2025-11-18T16:21:20-05:00 Fix a bug in defaulting Addresses #26582 Defaulting was doing some unification but then failing to iterate. Silly. I discovered that the main solver was unnecessarily iterating even if there was a unification for an /outer/ unification variable, so I fixed that too. - - - - - c12fa73e by Simon Peyton Jones at 2025-11-19T02:55:01-05:00 Make PmLit be in Ord, and use it in Map This MR addresses #26514, by changing from data PmAltConSet = PACS !(UniqDSet ConLike) ![PmLit] to data PmAltConSet = PACS !(UniqDSet ConLike) !(Map PmLit PmLit) This matters when doing pattern-match overlap checking, when there is a very large set of patterns. For most programs it makes no difference at all. For the N=5000 case of the repro case in #26514, compiler mutator time (with `-fno-code`) goes from 1.9s to 0.43s. All for the price for an Ord instance for PmLit - - - - - 41b84f40 by sheaf at 2025-11-19T02:55:52-05:00 Add passing tests for #26311 and #26072 This commit adds two tests cases that now pass since landing the changes to typechecking of data constructors in b33284c7. Fixes #26072 #26311 - - - - - 1faa758a by sheaf at 2025-11-19T02:55:52-05:00 mkCast: weaken bad cast warning for multiplicity This commit weakens the warning message emitted when constructing a bad cast in mkCast to ignore multiplicity. Justification: since b33284c7, GHC uses sub-multiplicity coercions to typecheck data constructors. The coercion optimiser is free to discard these coercions, both for performance reasons, and because GHC's Core simplifier does not (yet) preserve linearity. We thus weaken 'mkCast' to use 'eqTypeIgnoringMultiplicity' instead of 'eqType', to avoid getting many spurious warnings about mismatched multiplicities. - - - - - 55eab80d by Sylvain Henry at 2025-11-20T17:33:13-05:00 Build external interpreter program on demand (#24731) This patch teaches GHC how to build the external interpreter program when it is missing. As long as we have the `ghci` library, doing this is trivial so most of this patch is refactoring for doing it sanely. - - - - - 08bbc028 by Rodrigo Mesquita at 2025-11-20T17:33:54-05:00 Add tests for #23973 and #26565 These were fixed by 4af4f0f070f83f948e49ad5d7835fd91b8d3f0e6 in !10417 - - - - - 6b42232c by sheaf at 2025-11-20T17:34:35-05:00 Mark T26410_ffi as fragile on Windows As seen in #26595, this test intermittently fails on Windows. This commit marks it as fragile, until we get around to fixing it. - - - - - b7b7c049 by Andrew Lelechenko at 2025-11-21T21:04:01+00:00 Add nubOrd / nubOrdBy to Data.List and Data.List.NonEmpty As per https://github.com/haskell/core-libraries-committee/issues/336 - - - - - 352d5462 by Marc Scholten at 2025-11-22T10:33:03-05:00 Fix haddock test runner to handle UTF-8 output xhtml 3000.4.0.0 now produces UTF-8 output instead of escaping non-ASCII characters. When using --test-accept it previously wrote files in the wrong encoding because they have not been decoded properly when reading the files. - - - - - 748400c2 by Peter Trommler at 2025-11-22T16:38:31+01:00 Use half-word literals in info tables - - - - - 6d5e8d63 by Peter Trommler at 2025-11-22T16:38:31+01:00 Fix fun_type, arity when tables next to code With tables next to code extra_bits are reversed but fun_type and arity were packed into one Word and are now two separate HalfWords. - - - - - 436ea6ac by Peter Trommler at 2025-11-22T16:38:31+01:00 Remove dead code - - - - - 244 changed files: - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/RoughMap.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Config/Core/Lint.hs - + compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/Config/Linker.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Config.hs - compiler/GHC/Linker/Dynamic.hs - + compiler/GHC/Linker/Executable.hs - − compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Linker/Windows.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - + compiler/GHC/Runtime/Interpreter/C.hs - + compiler/GHC/Runtime/Interpreter/Init.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Rts/Types.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/SourceText.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/arrows.rst - docs/users_guide/exts/derive_any_class.rst - docs/users_guide/exts/deriving_extra.rst - docs/users_guide/exts/deriving_inferred.rst - docs/users_guide/exts/deriving_strategies.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/generics.rst - docs/users_guide/exts/overloaded_labels.rst - docs/users_guide/exts/overloaded_strings.rst - docs/users_guide/exts/pattern_synonyms.rst - docs/users_guide/exts/poly_kinds.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/rank_polymorphism.rst - docs/users_guide/exts/rebindable_syntax.rst - docs/users_guide/exts/required_type_arguments.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/standalone_deriving.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/exts/tuple_sections.rst - docs/users_guide/exts/type_data.rst - docs/users_guide/exts/type_defaulting.rst - docs/users_guide/gone_wrong.rst - docs/users_guide/hints.rst - docs/users_guide/javascript.rst - docs/users_guide/phases.rst - docs/users_guide/profiling.rst - docs/users_guide/separate_compilation.rst - docs/users_guide/using.rst - docs/users_guide/wasm.rst - docs/users_guide/win32-dlls.rst - hadrian/stack.yaml - hadrian/stack.yaml.lock - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Data/List.hs - libraries/base/src/Data/List/NonEmpty.hs - + libraries/base/src/Data/List/NubOrdSet.hs - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - testsuite/tests/backpack/should_fail/T19244a.stderr - + testsuite/tests/bytecode/T23973.hs - + testsuite/tests/bytecode/T23973.script - + testsuite/tests/bytecode/T23973.stdout - + testsuite/tests/bytecode/T26565.hs - + testsuite/tests/bytecode/T26565.script - + testsuite/tests/bytecode/T26565.stdout - testsuite/tests/bytecode/all.T - + testsuite/tests/codeGen/should_run/T26537.hs - + testsuite/tests/codeGen/should_run/T26537.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/dependent/should_fail/T11334b.stderr - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T24731.hs - + testsuite/tests/driver/T26551.hs - + testsuite/tests/driver/T26551.stderr - testsuite/tests/driver/all.T - testsuite/tests/generics/T10604/T10604_deriving.stderr - testsuite/tests/ghc-e/should_fail/T9930fail.stderr - testsuite/tests/ghc-e/should_fail/all.T - testsuite/tests/ghci.debugger/scripts/print012.stdout - testsuite/tests/ghci/scripts/T10321.stdout - testsuite/tests/ghci/scripts/T24459.stdout - testsuite/tests/ghci/scripts/T7730.stdout - testsuite/tests/ghci/scripts/T8959b.stderr - testsuite/tests/ghci/scripts/ghci051.stderr - testsuite/tests/ghci/scripts/ghci065.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/indexed-types/should_compile/T12538.stderr - testsuite/tests/indexed-types/should_fail/T21092.hs - − testsuite/tests/indexed-types/should_fail/T21092.stderr - testsuite/tests/indexed-types/should_fail/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/interface-stability/base-exports.stdout-ws-32 - + testsuite/tests/linear/should_compile/LinearEtaExpansions.hs - testsuite/tests/linear/should_compile/all.T - testsuite/tests/linear/should_fail/TypeClass.hs - testsuite/tests/linear/should_fail/TypeClass.stderr - testsuite/tests/linear/should_run/LinearGhci.stdout - + testsuite/tests/linear/should_run/T26311.hs - + testsuite/tests/linear/should_run/T26311.stdout - testsuite/tests/linear/should_run/all.T - testsuite/tests/numeric/should_compile/T16402.stderr-ws-64 - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/pmcheck/should_compile/pmcOrPats.stderr - testsuite/tests/rename/should_fail/rnfail055.stderr - testsuite/tests/rep-poly/RepPolyCase1.stderr - − testsuite/tests/rep-poly/RepPolyCase2.stderr - testsuite/tests/rep-poly/RepPolyRule3.stderr - testsuite/tests/rep-poly/RepPolyTuple4.stderr - testsuite/tests/rep-poly/T13233.stderr - − testsuite/tests/rep-poly/T17021.stderr - testsuite/tests/rep-poly/T20363b.stderr - − testsuite/tests/rep-poly/T21650_a.stderr - − testsuite/tests/rep-poly/T21650_b.stderr - + testsuite/tests/rep-poly/T26072.hs - + testsuite/tests/rep-poly/T26072b.hs - testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr - testsuite/tests/rep-poly/all.T - testsuite/tests/saks/should_compile/saks023.stdout - testsuite/tests/saks/should_compile/saks034.stdout - testsuite/tests/saks/should_compile/saks035.stdout - testsuite/tests/showIface/Makefile - + testsuite/tests/showIface/T26246a.hs - + testsuite/tests/showIface/T26246a.stdout - testsuite/tests/showIface/all.T - + testsuite/tests/simd/should_run/T26410_ffi.hs - + testsuite/tests/simd/should_run/T26410_ffi.stdout - + testsuite/tests/simd/should_run/T26410_ffi_c.c - + testsuite/tests/simd/should_run/T26410_prim.hs - + testsuite/tests/simd/should_run/T26410_prim.stdout - + testsuite/tests/simd/should_run/T26542.hs - + testsuite/tests/simd/should_run/T26542.stdout - + testsuite/tests/simd/should_run/T26550.hs - + testsuite/tests/simd/should_run/T26550.stdout - testsuite/tests/simd/should_run/all.T - testsuite/tests/typecheck/T16127/T16127.stderr - testsuite/tests/typecheck/should_compile/T22560d.stdout - + testsuite/tests/typecheck/should_compile/T26582.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T15629.stderr - testsuite/tests/typecheck/should_fail/T15883e.stderr - testsuite/tests/typecheck/should_fail/T2414.stderr - testsuite/tests/typecheck/should_fail/T24279.hs - − testsuite/tests/typecheck/should_fail/T24279.stderr - testsuite/tests/typecheck/should_fail/T2534.stderr - testsuite/tests/typecheck/should_fail/T7264.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-test/src/Test/Haddock.hs - utils/haddock/html-test/ref/Bug1004.html - utils/haddock/html-test/ref/Bug1050.html - + utils/haddock/html-test/ref/Bug26246.html - utils/haddock/html-test/ref/Bug85.html - utils/haddock/html-test/ref/Bug923.html - utils/haddock/html-test/ref/BundledPatterns.html - utils/haddock/html-test/ref/BundledPatterns2.html - utils/haddock/html-test/ref/ConstructorPatternExport.html - utils/haddock/html-test/ref/GADTRecords.html - utils/haddock/html-test/ref/LinearTypes.html - utils/haddock/html-test/ref/PromotedTypes.html - + utils/haddock/html-test/src/Bug26246.hs - utils/haddock/hypsrc-test/ref/src/Classes.html - utils/haddock/hypsrc-test/ref/src/Quasiquoter.html - utils/haddock/latex-test/ref/LinearTypes/LinearTypes.tex - utils/iserv/iserv.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/060ac94065cac9e3b53c2e6b9635d0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/060ac94065cac9e3b53c2e6b9635d0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Fix haddock test runner to handle UTF-8 output
by Marge Bot (＠marge-bot) 22 Nov '25

22 Nov '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 352d5462 by Marc Scholten at 2025-11-22T10:33:03-05:00 Fix haddock test runner to handle UTF-8 output xhtml 3000.4.0.0 now produces UTF-8 output instead of escaping non-ASCII characters. When using --test-accept it previously wrote files in the wrong encoding because they have not been decoded properly when reading the files. - - - - - 1 changed file: - utils/haddock/haddock-test/src/Test/Haddock.hs Changes: ===================================== utils/haddock/haddock-test/src/Test/Haddock.hs ===================================== @@ -8,7 +8,6 @@ module Test.Haddock ) where import Control.Monad -import qualified Data.ByteString.Char8 as BS import qualified Data.Map.Strict as Map import Data.Foldable (for_) import Data.Maybe @@ -211,7 +210,7 @@ checkFile cfg file = do ccfg = cfgCheckConfig cfg dcfg = cfgDirConfig cfg --- We use ByteString here to ensure that no lazy I/O is performed. +-- We use readFile' here to ensure that no lazy I/O is performed. -- This way to ensure that the reference file isn't held open in -- case after `diffFile` (which is problematic if we need to rewrite -- the reference file in `maybeAcceptFile`) @@ -219,8 +218,8 @@ checkFile cfg file = do -- | Read the reference artifact for a test readRef :: Config c -> FilePath -> IO (Maybe c) readRef cfg file = - ccfgRead ccfg . BS.unpack - <$> BS.readFile (refFile dcfg file) + ccfgRead ccfg + <$> readFile' (refFile dcfg file) where ccfg = cfgCheckConfig cfg dcfg = cfgDirConfig cfg @@ -228,8 +227,8 @@ readRef cfg file = -- | Read (and clean) the test output artifact for a test readOut :: Config c -> (DirConfig -> FilePath) -> FilePath -> IO c readOut cfg dcfgDir file = do - res <- fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack - <$> BS.readFile outFile + res <- fmap (ccfgClean ccfg file) . ccfgRead ccfg + <$> readFile' outFile case res of Just out -> return out Nothing -> error $ "Failed to parse output file: " ++ outFile View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/352d54621121c25f8f84f994936dd38… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/352d54621121c25f8f84f994936dd38… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add nubOrd / nubOrdBy to Data.List and Data.List.NonEmpty
by Marge Bot (＠marge-bot) 22 Nov '25

22 Nov '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b7b7c049 by Andrew Lelechenko at 2025-11-21T21:04:01+00:00 Add nubOrd / nubOrdBy to Data.List and Data.List.NonEmpty As per https://github.com/haskell/core-libraries-committee/issues/336 - - - - - 10 changed files: - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Data/List.hs - libraries/base/src/Data/List/NonEmpty.hs - + libraries/base/src/Data/List/NubOrdSet.hs - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/base.cabal.in ===================================== @@ -303,6 +303,7 @@ Library , GHC.JS.Foreign.Callback other-modules: + Data.List.NubOrdSet System.CPUTime.Unsupported System.CPUTime.Utils if os(windows) ===================================== libraries/base/changelog.md ===================================== @@ -10,6 +10,7 @@ * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350)) * Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339)) * Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335) + * Add `nubOrd` / `nubOrdBy` to `Data.List` and `Data.List.NonEmpty`. ([CLC proposal #336](https://github.com/haskell/core-libraries-committee/issues/336)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/Data/List.hs ===================================== @@ -136,7 +136,11 @@ module Data.List unlines, unwords, -- ** \"Set\" operations + -- | Consider using @Data.Set@ from @containers@ package, + -- which offers a much wider and often more efficient range + -- of operations on sets. nub, + nubOrd, delete, (\\), union, @@ -157,6 +161,7 @@ module Data.List -- *** User-supplied equality (replacing an @Eq@ context) -- | The predicate is assumed to define an equivalence. nubBy, + nubOrdBy, deleteBy, deleteFirstsBy, unionBy, @@ -180,12 +185,14 @@ module Data.List ) where import GHC.Internal.Data.Bool (otherwise) +import GHC.Internal.Data.Function (const) import GHC.Internal.Data.List import GHC.Internal.Data.List.NonEmpty (NonEmpty(..)) -import GHC.Internal.Data.Ord (Ordering(..), (<), (>)) +import GHC.Internal.Data.Ord (Ord, compare, Ordering(..), (<), (>)) import GHC.Internal.Int (Int) import GHC.Internal.Num ((-)) import GHC.List (build) +import qualified Data.List.NubOrdSet as NubOrdSet inits1, tails1 :: [a] -> [NonEmpty a] @@ -282,3 +289,25 @@ compareLength xs n (\m -> if m > 0 then LT else EQ) xs n + +-- | Same as 'nub', but asymptotically faster, taking only /O/(/n/ log /d/) time, +-- where /d/ is the number of distinct elements in the list. +-- +-- @since 4.23.0.0 +nubOrd :: Ord a => [a] -> [a] +nubOrd = nubOrdBy compare +{-# INLINE nubOrd #-} + +-- | Overloaded version of 'Data.List.nubOrd'. +-- +-- The supplied comparison relation is supposed to be reflexive, transitive +-- and antisymmetric, same as for 'sortBy'. +-- +-- @since 4.23.0.0 +nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a] +nubOrdBy cmp xs = foldr + (\x cont seen -> if NubOrdSet.member cmp x seen then cont seen else x : cont (NubOrdSet.insert cmp x seen)) + (const []) + xs + NubOrdSet.empty +{-# INLINE nubOrdBy #-} ===================================== libraries/base/src/Data/List/NonEmpty.hs ===================================== @@ -94,7 +94,9 @@ module Data.List.NonEmpty ( , isPrefixOf -- :: Eq a => [a] -> NonEmpty a -> Bool -- * \"Set\" operations , nub -- :: Eq a => NonEmpty a -> NonEmpty a + , nubOrd -- :: Ord a => NonEmpty a -> NonEmpty a , nubBy -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a + , nubOrdBy -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -- * Indexing streams , (!!) -- :: NonEmpty a -> Int -> a -- * Zipping and unzipping streams @@ -119,6 +121,7 @@ import qualified Prelude import Control.Applicative (Applicative (..), Alternative (many)) import qualified Data.List as List +import qualified Data.List.NubOrdSet as NubOrdSet import qualified Data.Maybe as List (mapMaybe) import GHC.Internal.Data.Foldable hiding (length, toList) import qualified GHC.Internal.Data.Foldable as Foldable @@ -568,6 +571,13 @@ unzip ((a, b) :| asbs) = (a :| as, b :| bs) -- (The name 'nub' means \'essence\'.) -- It is a special case of 'nubBy', which allows the programmer to -- supply their own inequality test. +-- +-- This function knows too little about the elements to be efficient. +-- Its asymptotic complexity is +-- /O/(/n/ ⋅ /d/), where /d/ is the number of distinct elements in the list. +-- +-- If there exists @instance Ord a@, it's faster to use 'Data.List.NonEmpty.nubOrd'. +-- nub :: Eq a => NonEmpty a -> NonEmpty a nub = nubBy (==) @@ -577,6 +587,25 @@ nub = nubBy (==) nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a nubBy eq (a :| as) = a :| List.nubBy eq (List.filter (\b -> not (eq a b)) as) +-- | Same as 'nub', but asymptotically faster, taking only /O/(/n/ log /d/) time. +-- where /d/ is the number of distinct elements in the list. +-- +-- @since 4.23.0.0 +nubOrd :: Ord a => NonEmpty a -> NonEmpty a +nubOrd = nubOrdBy compare +{-# INLINE nubOrd #-} + +-- | Overloaded version of 'Data.List.NonEmpty.nubOrd'. +-- +-- @since 4.23.0.0 +nubOrdBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a +nubOrdBy cmp (y :| ys) = y :| foldr + (\x cont seen -> if NubOrdSet.member cmp x seen then cont seen else x : cont (NubOrdSet.insert cmp x seen)) + (const []) + ys + (NubOrdSet.insert cmp y NubOrdSet.empty) +{-# INLINE nubOrdBy #-} + -- | 'transpose' for 'NonEmpty', behaves the same as 'GHC.Internal.Data.List.transpose' -- The rows/columns need not be the same length, in which case -- > transpose . transpose /= id ===================================== libraries/base/src/Data/List/NubOrdSet.hs ===================================== @@ -0,0 +1,81 @@ +-- This is an internal module with a naive set implementation, +-- solely for the purposes of `Data.List.{,NonEmpty.}nubOrd{,By}`. + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} + +module Data.List.NubOrdSet ( + NubOrdSet, + empty, + member, + insert, +) where + +import GHC.Internal.Data.Bool (Bool(..)) +import GHC.Internal.Data.Function ((.)) +import GHC.Internal.Data.Ord (Ordering(..)) + +-- | Implemented as a red-black tree, a la Okasaki. +data NubOrdSet a + = Empty + | NodeRed !(NubOrdSet a) !a !(NubOrdSet a) + | NodeBlack !(NubOrdSet a) !a !(NubOrdSet a) + +empty :: NubOrdSet a +empty = Empty + +member :: (a -> a -> Ordering) -> a -> NubOrdSet a -> Bool +member cmp = member' + where + member' !x = go + where + go = \case + Empty -> False + NodeRed left center right -> chooseWay left center right + NodeBlack left center right -> chooseWay left center right + + chooseWay left center right = case cmp x center of + LT -> go left + EQ -> True + GT -> go right +{-# INLINE member #-} + +insert :: (a -> a -> Ordering) -> a -> NubOrdSet a -> NubOrdSet a +insert cmp = insert' + where + insert' !x = blacken . go + where + go node = case node of + Empty -> NodeRed Empty x Empty + NodeRed left center right -> case cmp x center of + LT -> NodeRed (go left) center right + EQ -> node + GT -> NodeRed left center (go right) + NodeBlack left center right -> case cmp x center of + LT -> balanceBlackLeft (go left) center right + EQ -> node + GT -> balanceBlackRight left center (go right) + + blacken node = case node of + Empty -> Empty + NodeRed left center right -> NodeBlack left center right + NodeBlack{} -> node +{-# INLINE insert #-} + +balanceBlackLeft :: NubOrdSet a -> a -> NubOrdSet a -> NubOrdSet a +balanceBlackLeft (NodeRed (NodeRed a b c) d e) f g = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackLeft (NodeRed a b (NodeRed c d e)) f g = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackLeft left center right = + NodeBlack left center right +{-# INLINE balanceBlackLeft #-} + +balanceBlackRight :: NubOrdSet a -> a -> NubOrdSet a -> NubOrdSet a +balanceBlackRight a b (NodeRed (NodeRed c d e) f g) = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackRight a b (NodeRed c d (NodeRed e f g)) = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackRight left center right = + NodeBlack left center right +{-# INLINE balanceBlackRight #-} ===================================== libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs ===================================== @@ -494,21 +494,16 @@ dropLengthMaybe (_:x') (_:y') = dropLengthMaybe x' y' isInfixOf :: (Eq a) => [a] -> [a] -> Bool isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) --- | $\mathcal{O}(n^2)$. The 'nub' function removes duplicate elements from a +-- | The 'nub' function removes duplicate elements from a -- list. In particular, it keeps only the first occurrence of each element. (The -- name 'nub' means \`essence\'.) It is a special case of 'nubBy', which allows -- the programmer to supply their own equality test. -- +-- This function knows too little about the elements to be efficient. +-- Its asymptotic complexity is +-- /O/(/n/ ⋅ /d/), where /d/ is the number of distinct elements in the list. -- --- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package --- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Con…) --- which takes only $\mathcal{O}(n \log d)$ time where `d` is the number of --- distinct elements in the list. --- --- Another approach to speed up 'nub' is to use --- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes $\mathcal{O}(n \log n)$ time, requires @instance Ord a@ and doesn't --- preserve the order. +-- If there exists @instance Ord a@, it's faster to use 'Data.List.nubOrd'. -- -- ==== __Examples__ -- ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7b7c049cc17ffc3440c2ff3a6e1e32… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7b7c049cc17ffc3440c2ff3a6e1e32… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/warning-for-last-and-init] Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial
by Bodigrim (＠Bodigrim) 22 Nov '25

22 Nov '25

Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC Commits: 5ee11c69 by Mike Pilgrem at 2025-11-22T15:10:19+00:00 Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`). In module `Settings.Warnings`, applies `-Wno-x-partial` to the `filepath`, and `parsec` packages (outside GHC's repository). Also bumps submodules. - - - - - 25 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Prelude/Basic.hs - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/src/Settings/Warnings.hs - libraries/base/changelog.md - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs - testsuite/tests/driver/j-space/jspace.hs - testsuite/tests/rts/KeepCafsBase.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs - utils/ghc-pkg/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/hpc - utils/hsc2hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -115,7 +115,6 @@ import GHC.Utils.Misc import Data.ByteString ( ByteString ) import Data.Function ( on ) import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) -import qualified Data.List as Partial ( init, last ) import Data.Ord ( comparing ) import Control.Monad ( guard ) import qualified Data.Set as Set @@ -1896,10 +1895,10 @@ app_ok fun_ok primop_ok fun args PrimOpId op _ | primOpIsDiv op - , Lit divisor <- Partial.last args + , Lit divisor <- last args -- there can be 2 args (most div primops) or 3 args -- (WordQuotRem2Op), hence the use of last/init - -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (Partial.init args) + -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (init args) -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation -- (which primop_ok will catch), but they ARE OK ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -39,7 +39,7 @@ import System.FilePath import Control.Monad import Data.List ( partition, (\\) ) import qualified Data.Set as Set -import Prelude +import GHC.Prelude import GHC.ResponseFile (expandResponse) import Data.Bifunctor import GHC.Data.Graph.Directed ===================================== compiler/GHC/Prelude/Basic.hs ===================================== @@ -2,8 +2,8 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -O2 #-} -- See Note [-O2 Prelude] --- See Note [Proxies for head and tail] -{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-x-partial #-} +-- See Note [Proxies for partial list functions] +{-# OPTIONS_GHC -Wno-x-partial #-} -- | Custom minimal GHC "Prelude" -- @@ -24,7 +24,7 @@ module GHC.Prelude.Basic , bit , shiftL, shiftR , setBit, clearBit - , head, tail, unzip + , head, tail, init, last, unzip , strictGenericLength ) where @@ -59,7 +59,7 @@ NoImplicitPrelude. There are two motivations for this: -} import qualified Prelude -import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, unzip) +import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, init, last, unzip) import Control.Applicative (Applicative(..)) import Data.Foldable as X (Foldable (elem, foldMap, foldl, foldl', foldr, length, null, product, sum)) import Data.Foldable1 as X hiding (head, last) @@ -118,24 +118,35 @@ setBit = \ x i -> x Bits..|. bit i clearBit :: (Num a, Bits.Bits a) => a -> Int -> a clearBit = \ x i -> x Bits..&. Bits.complement (bit i) -{- Note [Proxies for head and tail] +{- Note [Proxies for partial list functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Prelude.head and Prelude.tail have recently acquired {-# WARNING in "x-partial" #-}, +Prelude.head, Prelude.tail, Prelude.init and Prelude.last +have recently acquired {-# WARNING in "x-partial" #-}, but the GHC codebase uses them fairly extensively and insists on building warning-free. Thus, instead of adding {-# OPTIONS_GHC -Wno-x-partial #-} to every module which employs them, we define warning-less proxies and export them from GHC.Prelude. -} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] head :: HasCallStack => [a] -> a head = Prelude.head {-# INLINE head #-} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] tail :: HasCallStack => [a] -> [a] tail = Prelude.tail {-# INLINE tail #-} +-- See Note [Proxies for partial list functions] +init :: HasCallStack => [a] -> [a] +init = Prelude.init +{-# INLINE init #-} + +-- See Note [Proxies for partial list functions] +last :: HasCallStack => [a] -> a +last = Prelude.last +{-# INLINE last #-} + {- | The 'genericLength' function defined in base can't be specialised due to the NOINLINE pragma. ===================================== ghc/GHCi/UI.hs ===================================== @@ -145,7 +145,7 @@ import Data.Time.LocalTime ( getZonedTime ) import Data.Time.Format ( formatTime, defaultTimeLocale ) import Data.Version ( showVersion ) import qualified Data.Semigroup as S -import Prelude hiding ((<>)) +import GHC.Prelude import GHC.Utils.Exception as Exception hiding (catch, mask, handle) import Foreign hiding (void) ===================================== ghc/Main.hs ===================================== @@ -2,7 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE TupleSections #-} -{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} +{-# OPTIONS_GHC -Wno-x-partial -Wno-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} ----------------------------------------------------------------------------- -- ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -72,7 +72,11 @@ ghcWarningsArgs = do , package terminfo ? pure [ "-Wno-unused-imports", "-Wno-deriving-typeable" ] , package stm ? pure [ "-Wno-deriving-typeable" ] , package osString ? pure [ "-Wno-deriving-typeable", "-Wno-unused-imports" ] - , package parsec ? pure [ "-Wno-deriving-typeable" ] + , package parsec ? pure [ "-Wno-deriving-typeable" + , "-Wno-x-partial" + ] + + , package filepath ? pure [ "-Wno-x-partial" ] , package cabal ? pure [ "-Wno-deriving-typeable", "-Wno-incomplete-record-selectors" ] -- The -Wno-incomplete-record-selectors is due to ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,9 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.23.0.0 *TBA* + * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{init,last}`. + Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. + ([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/292)) * Remove deprecated, unstable heap representation details from `GHC.Exts` ([CLC proposal #212](https://github.com/haskell/core-libraries-committee/issues/212)) * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337)) * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338)) ===================================== libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -Wno-x-partial #-} -- | contains a prettyprinter for the -- Template Haskell datatypes ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -13,6 +13,9 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +-- For init in formatRealFloatAlt +{-# OPTIONS_GHC -Wno-x-partial #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Internal.Float ===================================== libraries/ghc-internal/src/GHC/Internal/List.hs ===================================== @@ -190,12 +190,18 @@ tail :: HasCallStack => [a] -> [a] tail (_:xs) = xs tail [] = errorEmptyList "tail" -{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'GHC.Internal.Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} +{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} -- | $\mathcal{O}(n)$. Extract the last element of a list, which must be -- finite and non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -218,10 +224,18 @@ last xs = foldl (\_ x -> x) lastError xs lastError :: HasCallStack => a lastError = errorEmptyList "last" +{-# WARNING in "x-partial" last "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(n)$. Return all the elements of a list except the last one. -- The list must be non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -240,6 +254,8 @@ init (x:xs) = init' x xs where init' _ [] = [] init' y (z:zs) = y : init' z zs +{-# WARNING in "x-partial" init "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(1)$. Test whether a list is empty. -- -- >>> null [] ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-} +{-# OPTIONS_GHC -Wno-x-partial #-} ----------------------------------------------------------------------------- -- | ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead +{-# OPTIONS_GHC -Wno-x-partial #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -1,6 +1,7 @@ -- Vendored from filepath v1.4.2.2 {-# LANGUAGE PatternGuards #-} +{-# OPTIONS_GHC -Wno-x-partial #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -1,6 +1,7 @@ -- Vendored from filepath v1.4.2.2 {-# LANGUAGE PatternGuards #-} +{-# OPTIONS_GHC -Wno-x-partial #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -7,7 +7,7 @@ import System.Environment import GHC.Driver.Env.Types import GHC.Profiling import System.Mem -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, unsnoc) import Control.Monad import System.Exit import GHC.Platform @@ -41,7 +41,9 @@ initGhcM xs = do requestHeapCensus performGC [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" - let (n :: Int) = read (last (words ys)) + let (n :: Int) = case unsnoc (words ys) of + Nothing -> error "input is unexpectedly empty" + Just (_, lst) -> read lst -- The output should be 50 * 8 * word_size (i.e. 3600, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, -- and each ModDetails contains 1 (info table) + 8 word-sized fields. ===================================== testsuite/tests/rts/KeepCafsBase.hs ===================================== @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-x-partial #-} + module KeepCafsBase (x) where x :: Int ===================================== utils/check-exact/Main.hs ===================================== @@ -6,6 +6,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-x-partial #-} import Data.Data import Data.List (intercalate) ===================================== utils/check-exact/Transform.hs ===================================== @@ -96,6 +96,7 @@ import GHC.Data.FastString import GHC.Types.SrcLoc import Data.Data +import Data.List (unsnoc) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe @@ -212,8 +213,9 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (AnnSig (EpUniTok dca u) mp md) ns ( where -- we want DPs for the distance from the end of the ns to the -- AnnDColon, and to the start of the ty - rd = case last ns of - L (EpAnn anc' _ _) _ -> epaLocationRealSrcSpan anc' + rd = case unsnoc ns of + Nothing -> error "unexpected empty list in 'ns' variable" + Just (_, L (EpAnn anc' _ _) _) -> epaLocationRealSrcSpan anc' dca' = case dca of EpaSpan ss@(RealSrcSpan r _) -> (EpaDelta ss (ss2delta (ss2posEnd rd) r) []) _ -> dca @@ -294,7 +296,7 @@ setEntryDP (L (EpAnn (EpaSpan ss@(RealSrcSpan r _)) an cs) a) dp where cs'' = setPriorComments cs [] csd = L (EpaDelta ss dp NoComments) c:commentOrigDeltas cs' - lc = last $ (L ca c:cs') + lc = NE.last (L ca c :| cs') delta = case getLoc lc of EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r EpaSpan _ -> (SameLine 0) ===================================== utils/check-exact/Utils.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Base (NonEmpty(..)) import GHC.Parser.Lexer (allocateComments) import Data.Data hiding ( Fixity ) -import Data.List (sortBy, partition) +import Data.List (sortBy, partition, unsnoc) import qualified Data.Map.Strict as Map import Debug.Trace @@ -734,8 +734,9 @@ ghead info [] = error $ "ghead "++info++" []" ghead _info (h:_) = h glast :: String -> [a] -> a -glast info [] = error $ "glast " ++ info ++ " []" -glast _info h = last h +glast info xs = case unsnoc xs of + Nothing -> error $ "glast " ++ info ++ " []" + Just (_, lst) -> lst gtail :: String -> [a] -> [a] gtail info [] = error $ "gtail " ++ info ++ " []" ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -8,7 +8,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-x-partial #-} -- Fine if this comes from make/Hadrian or the pre-built base. #include <ghcplatform.h> ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs ===================================== @@ -14,6 +14,7 @@ module GHC.Toolchain.Utils import Control.Exception import Control.Monad import Control.Monad.IO.Class +import Data.List (unsnoc) import System.Directory import System.FilePath import System.IO.Error @@ -67,5 +68,4 @@ isSuccess = \case ExitFailure _ -> False lastLine :: String -> String -lastLine "" = "" -lastLine s = last $ lines s +lastLine = maybe "" snd . unsnoc . lines ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs ===================================== @@ -755,7 +755,7 @@ ppHtmlIndex divAlphabet << unordList ( map (\str -> anchor ! [href (subIndexHtmlFile str)] << str) $ - [ [c] | c <- initialChars, any ((== c) . toUpper . head . fst) index + [ [c] | c <- initialChars, any (maybe False ((== c) . toUpper . fst) . List.uncons . fst) index ] ++ [merged_name] ) @@ -772,7 +772,7 @@ ppHtmlIndex writeUtf8File (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html) where html = indexPage True (Just c) index_part - index_part = [(n, stuff) | (n, stuff) <- this_ix, toUpper (head n) == c] + index_part = [(n, stuff) | (n@(headN : _), stuff) <- this_ix, toUpper headN == c] index :: [(String, Map GHC.Name [(Module, Bool)])] index = sortBy cmp (Map.toAscList full_index) ===================================== utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs ===================================== @@ -30,7 +30,7 @@ import Control.Arrow (first) import Control.Monad import Data.Char (chr, isAlpha, isSpace, isUpper) import Data.Functor (($>)) -import Data.List (elemIndex, intercalate, intersperse, unfoldr) +import Data.List (elemIndex, intercalate, intersperse, unfoldr, unsnoc) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import qualified Data.Set as Set @@ -870,10 +870,10 @@ codeblock = DocCodeBlock . parseParagraph . dropSpaces <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@") where - dropSpaces xs = - case splitByNl xs of - [] -> xs - ys -> case T.uncons (last ys) of + dropSpaces xs = let ys = splitByNl xs in + case unsnoc ys of + Nothing -> xs + Just (_, lastYs) -> case T.uncons lastYs of Just (' ', _) -> case mapM dropSpace ys of Nothing -> xs Just zs -> T.intercalate "\n" zs ===================================== utils/hpc ===================================== @@ -1 +1 @@ -Subproject commit 5923da3fe77993b7afc15b5163cffcaa7da6ecf5 +Subproject commit dd43f7e139d7a4f4908d1e8af35a75939f763ef1 ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit fe3990b9f35000427b016a79330d9f195587cad8 +Subproject commit 2059c961fc28bbfd0cafdbef96d5d21f1d911b53 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ee11c6936ff74dee8a880c45c48f54… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ee11c6936ff74dee8a880c45c48f54… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/warning-for-last-and-init] Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial
by Bodigrim (＠Bodigrim) 22 Nov '25

22 Nov '25

Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC Commits: 4b22118b by Mike Pilgrem at 2025-11-22T12:24:29+00:00 Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`). In module `Settings.Warnings`, applies `-Wno-x-partial` to the `filepath`, and `parsec` packages (outside GHC's repository). Also bumps submodules. - - - - - 25 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Prelude/Basic.hs - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/src/Settings/Warnings.hs - libraries/base/changelog.md - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs - testsuite/tests/driver/j-space/jspace.hs - testsuite/tests/rts/KeepCafsBase.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs - utils/ghc-pkg/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/hpc - utils/hsc2hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -115,7 +115,6 @@ import GHC.Utils.Misc import Data.ByteString ( ByteString ) import Data.Function ( on ) import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) -import qualified Data.List as Partial ( init, last ) import Data.Ord ( comparing ) import Control.Monad ( guard ) import qualified Data.Set as Set @@ -1896,10 +1895,10 @@ app_ok fun_ok primop_ok fun args PrimOpId op _ | primOpIsDiv op - , Lit divisor <- Partial.last args + , Lit divisor <- last args -- there can be 2 args (most div primops) or 3 args -- (WordQuotRem2Op), hence the use of last/init - -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (Partial.init args) + -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (init args) -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation -- (which primop_ok will catch), but they ARE OK ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -39,7 +39,7 @@ import System.FilePath import Control.Monad import Data.List ( partition, (\\) ) import qualified Data.Set as Set -import Prelude +import GHC.Prelude import GHC.ResponseFile (expandResponse) import Data.Bifunctor import GHC.Data.Graph.Directed ===================================== compiler/GHC/Prelude/Basic.hs ===================================== @@ -2,8 +2,8 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -O2 #-} -- See Note [-O2 Prelude] --- See Note [Proxies for head and tail] -{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-x-partial #-} +-- See Note [Proxies for partial list functions] +{-# OPTIONS_GHC -Wno-x-partial #-} -- | Custom minimal GHC "Prelude" -- @@ -24,7 +24,7 @@ module GHC.Prelude.Basic , bit , shiftL, shiftR , setBit, clearBit - , head, tail, unzip + , head, tail, init, last, unzip , strictGenericLength ) where @@ -59,7 +59,7 @@ NoImplicitPrelude. There are two motivations for this: -} import qualified Prelude -import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, unzip) +import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, init, last, unzip) import Control.Applicative (Applicative(..)) import Data.Foldable as X (Foldable (elem, foldMap, foldl, foldl', foldr, length, null, product, sum)) import Data.Foldable1 as X hiding (head, last) @@ -118,24 +118,35 @@ setBit = \ x i -> x Bits..|. bit i clearBit :: (Num a, Bits.Bits a) => a -> Int -> a clearBit = \ x i -> x Bits..&. Bits.complement (bit i) -{- Note [Proxies for head and tail] +{- Note [Proxies for partial list functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Prelude.head and Prelude.tail have recently acquired {-# WARNING in "x-partial" #-}, +Prelude.head, Prelude.tail, Prelude.init and Prelude.last +have recently acquired {-# WARNING in "x-partial" #-}, but the GHC codebase uses them fairly extensively and insists on building warning-free. Thus, instead of adding {-# OPTIONS_GHC -Wno-x-partial #-} to every module which employs them, we define warning-less proxies and export them from GHC.Prelude. -} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] head :: HasCallStack => [a] -> a head = Prelude.head {-# INLINE head #-} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] tail :: HasCallStack => [a] -> [a] tail = Prelude.tail {-# INLINE tail #-} +-- See Note [Proxies for partial list functions] +init :: HasCallStack => [a] -> [a] +init = Prelude.init +{-# INLINE init #-} + +-- See Note [Proxies for partial list functions] +last :: HasCallStack => [a] -> a +last = Prelude.last +{-# INLINE last #-} + {- | The 'genericLength' function defined in base can't be specialised due to the NOINLINE pragma. ===================================== ghc/GHCi/UI.hs ===================================== @@ -145,7 +145,7 @@ import Data.Time.LocalTime ( getZonedTime ) import Data.Time.Format ( formatTime, defaultTimeLocale ) import Data.Version ( showVersion ) import qualified Data.Semigroup as S -import Prelude hiding ((<>)) +import GHC.Prelude hiding ((<>)) import GHC.Utils.Exception as Exception hiding (catch, mask, handle) import Foreign hiding (void) ===================================== ghc/Main.hs ===================================== @@ -2,7 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE TupleSections #-} -{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} +{-# OPTIONS_GHC -Wno-x-partial -Wno-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} ----------------------------------------------------------------------------- -- ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -72,7 +72,11 @@ ghcWarningsArgs = do , package terminfo ? pure [ "-Wno-unused-imports", "-Wno-deriving-typeable" ] , package stm ? pure [ "-Wno-deriving-typeable" ] , package osString ? pure [ "-Wno-deriving-typeable", "-Wno-unused-imports" ] - , package parsec ? pure [ "-Wno-deriving-typeable" ] + , package parsec ? pure [ "-Wno-deriving-typeable" + , "-Wno-x-partial" + ] + + , package filepath ? pure [ "-Wno-x-partial" ] , package cabal ? pure [ "-Wno-deriving-typeable", "-Wno-incomplete-record-selectors" ] -- The -Wno-incomplete-record-selectors is due to ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,9 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.23.0.0 *TBA* + * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{init,last}`. + Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. + ([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/292)) * Remove deprecated, unstable heap representation details from `GHC.Exts` ([CLC proposal #212](https://github.com/haskell/core-libraries-committee/issues/212)) * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337)) * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338)) ===================================== libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -Wno-x-partial #-} -- | contains a prettyprinter for the -- Template Haskell datatypes ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -13,6 +13,9 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +-- For init in formatRealFloatAlt +{-# OPTIONS_GHC -Wno-x-partial #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Internal.Float ===================================== libraries/ghc-internal/src/GHC/Internal/List.hs ===================================== @@ -190,12 +190,18 @@ tail :: HasCallStack => [a] -> [a] tail (_:xs) = xs tail [] = errorEmptyList "tail" -{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'GHC.Internal.Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} +{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} -- | $\mathcal{O}(n)$. Extract the last element of a list, which must be -- finite and non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -218,10 +224,18 @@ last xs = foldl (\_ x -> x) lastError xs lastError :: HasCallStack => a lastError = errorEmptyList "last" +{-# WARNING in "x-partial" last "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(n)$. Return all the elements of a list except the last one. -- The list must be non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -240,6 +254,8 @@ init (x:xs) = init' x xs where init' _ [] = [] init' y (z:zs) = y : init' z zs +{-# WARNING in "x-partial" init "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(1)$. Test whether a list is empty. -- -- >>> null [] ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-} +{-# OPTIONS_GHC -Wno-x-partial #-} ----------------------------------------------------------------------------- -- | ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead +{-# OPTIONS_GHC -Wno-x-partial #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs ===================================== @@ -1,6 +1,7 @@ -- Vendored from filepath v1.4.2.2 {-# LANGUAGE PatternGuards #-} +{-# OPTIONS_GHC -Wno-x-partial #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -1,6 +1,7 @@ -- Vendored from filepath v1.4.2.2 {-# LANGUAGE PatternGuards #-} +{-# OPTIONS_GHC -Wno-x-partial #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -7,7 +7,7 @@ import System.Environment import GHC.Driver.Env.Types import GHC.Profiling import System.Mem -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, unsnoc) import Control.Monad import System.Exit import GHC.Platform @@ -41,7 +41,9 @@ initGhcM xs = do requestHeapCensus performGC [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" - let (n :: Int) = read (last (words ys)) + let (n :: Int) = case unsnoc (words ys) of + Nothing -> error "input is unexpectedly empty" + Just (_, lst) -> read lst -- The output should be 50 * 8 * word_size (i.e. 3600, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, -- and each ModDetails contains 1 (info table) + 8 word-sized fields. ===================================== testsuite/tests/rts/KeepCafsBase.hs ===================================== @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-x-partial #-} + module KeepCafsBase (x) where x :: Int ===================================== utils/check-exact/Main.hs ===================================== @@ -6,6 +6,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-x-partial #-} import Data.Data import Data.List (intercalate) ===================================== utils/check-exact/Transform.hs ===================================== @@ -96,6 +96,7 @@ import GHC.Data.FastString import GHC.Types.SrcLoc import Data.Data +import Data.List (unsnoc) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe @@ -212,8 +213,9 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (AnnSig (EpUniTok dca u) mp md) ns ( where -- we want DPs for the distance from the end of the ns to the -- AnnDColon, and to the start of the ty - rd = case last ns of - L (EpAnn anc' _ _) _ -> epaLocationRealSrcSpan anc' + rd = case unsnoc ns of + Nothing -> error "unexpected empty list in 'ns' variable" + Just (_, L (EpAnn anc' _ _) _) -> epaLocationRealSrcSpan anc' dca' = case dca of EpaSpan ss@(RealSrcSpan r _) -> (EpaDelta ss (ss2delta (ss2posEnd rd) r) []) _ -> dca @@ -294,7 +296,7 @@ setEntryDP (L (EpAnn (EpaSpan ss@(RealSrcSpan r _)) an cs) a) dp where cs'' = setPriorComments cs [] csd = L (EpaDelta ss dp NoComments) c:commentOrigDeltas cs' - lc = last $ (L ca c:cs') + lc = NE.last (L ca c :| cs') delta = case getLoc lc of EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r EpaSpan _ -> (SameLine 0) ===================================== utils/check-exact/Utils.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Base (NonEmpty(..)) import GHC.Parser.Lexer (allocateComments) import Data.Data hiding ( Fixity ) -import Data.List (sortBy, partition) +import Data.List (sortBy, partition, unsnoc) import qualified Data.Map.Strict as Map import Debug.Trace @@ -734,8 +734,9 @@ ghead info [] = error $ "ghead "++info++" []" ghead _info (h:_) = h glast :: String -> [a] -> a -glast info [] = error $ "glast " ++ info ++ " []" -glast _info h = last h +glast info xs = case unsnoc xs of + Nothing -> error $ "glast " ++ info ++ " []" + Just (_, lst) -> lst gtail :: String -> [a] -> [a] gtail info [] = error $ "gtail " ++ info ++ " []" ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -8,7 +8,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-x-partial #-} -- Fine if this comes from make/Hadrian or the pre-built base. #include <ghcplatform.h> ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs ===================================== @@ -14,6 +14,7 @@ module GHC.Toolchain.Utils import Control.Exception import Control.Monad import Control.Monad.IO.Class +import Data.List (unsnoc) import System.Directory import System.FilePath import System.IO.Error @@ -67,5 +68,4 @@ isSuccess = \case ExitFailure _ -> False lastLine :: String -> String -lastLine "" = "" -lastLine s = last $ lines s +lastLine = maybe "" snd . unsnoc . lines ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs ===================================== @@ -755,7 +755,7 @@ ppHtmlIndex divAlphabet << unordList ( map (\str -> anchor ! [href (subIndexHtmlFile str)] << str) $ - [ [c] | c <- initialChars, any ((== c) . toUpper . head . fst) index + [ [c] | c <- initialChars, any (maybe False ((== c) . toUpper . fst) . List.uncons . fst) index ] ++ [merged_name] ) @@ -772,7 +772,7 @@ ppHtmlIndex writeUtf8File (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html) where html = indexPage True (Just c) index_part - index_part = [(n, stuff) | (n, stuff) <- this_ix, toUpper (head n) == c] + index_part = [(n, stuff) | (n@(headN : _), stuff) <- this_ix, toUpper headN == c] index :: [(String, Map GHC.Name [(Module, Bool)])] index = sortBy cmp (Map.toAscList full_index) ===================================== utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs ===================================== @@ -30,7 +30,7 @@ import Control.Arrow (first) import Control.Monad import Data.Char (chr, isAlpha, isSpace, isUpper) import Data.Functor (($>)) -import Data.List (elemIndex, intercalate, intersperse, unfoldr) +import Data.List (elemIndex, intercalate, intersperse, unfoldr, unsnoc) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import qualified Data.Set as Set @@ -870,10 +870,10 @@ codeblock = DocCodeBlock . parseParagraph . dropSpaces <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@") where - dropSpaces xs = - case splitByNl xs of - [] -> xs - ys -> case T.uncons (last ys) of + dropSpaces xs = let ys = splitByNl xs in + case unsnoc ys of + Nothing -> xs + Just (_, lastYs) -> case T.uncons lastYs of Just (' ', _) -> case mapM dropSpace ys of Nothing -> xs Just zs -> T.intercalate "\n" zs ===================================== utils/hpc ===================================== @@ -1 +1 @@ -Subproject commit 5923da3fe77993b7afc15b5163cffcaa7da6ecf5 +Subproject commit dd43f7e139d7a4f4908d1e8af35a75939f763ef1 ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit fe3990b9f35000427b016a79330d9f195587cad8 +Subproject commit 2059c961fc28bbfd0cafdbef96d5d21f1d911b53 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b22118b0fd99e9ed6e53ac979f608f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b22118b0fd99e9ed6e53ac979f608f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26579] Fix fun_type, arity when tables next to code
by Peter Trommler (＠trommler) 22 Nov '25

22 Nov '25

Peter Trommler pushed to branch wip/T26579 at Glasgow Haskell Compiler / GHC Commits: 060ac940 by Peter Trommler at 2025-11-22T13:11:06+01:00 Fix fun_type, arity when tables next to code With tables next to code extra_bits are reversed but fun_type and arity were packed into one Word and are now two separate HalfWords. - - - - - 1 changed file: - compiler/GHC/Cmm/Info.hs Changes: ===================================== compiler/GHC/Cmm/Info.hs ===================================== @@ -28,7 +28,7 @@ module GHC.Cmm.Info ( conInfoTableSizeB, stdSrtBitmapOffset, stdClosureTypeOffset, - stdPtrsOffset, stdNonPtrsOffset, + stdPtrsOffset, stdNonPtrsOffset ) where import GHC.Prelude @@ -215,6 +215,15 @@ mkInfoTableContents profile ; return (prof_data ++ ct_data, (std_info, extra_bits)) } where platform = profilePlatform profile + mk_extra_bits :: Int -> Int -> [CmmLit] + mk_extra_bits low high + = if platformTablesNextToCode platform + then [ mkStgHalfWordCLit platform high + , mkStgHalfWordCLit platform low + ] + else [ mkStgHalfWordCLit platform low + , mkStgHalfWordCLit platform high + ] mk_pieces :: ClosureTypeInfo -> [CmmLit] -> UniqDSM ( Maybe CmmLit -- Override the SRT field with this , Maybe [CmmLit] -- Override the layout field with this @@ -235,18 +244,16 @@ mkInfoTableContents profile -- Layout known (one free var); we use the layout field for offset mk_pieces (Fun arity (ArgSpec fun_type)) srt_label - = do { let extra_bits = mkStgHalfWordCLit platform fun_type - : mkStgHalfWordCLit platform arity - : srt_label + = do { let extra_bits = mk_extra_bits fun_type arity + ++ srt_label ; return (Nothing, Nothing, extra_bits, []) } mk_pieces (Fun arity (ArgGen arg_bits)) srt_label = do { (liveness_lit, liveness_data) <- mkLivenessBits platform arg_bits ; let fun_type | null liveness_data = aRG_GEN | otherwise = aRG_GEN_BIG - extra_bits = mkStgHalfWordCLit platform fun_type - : mkStgHalfWordCLit platform arity - : (if inlineSRT platform then [] else [ srt_lit ]) + extra_bits = mk_extra_bits fun_type arity + ++ (if inlineSRT platform then [] else [ srt_lit ]) ++ [ liveness_lit, slow_entry ] ; return (Nothing, Nothing, extra_bits, liveness_data) } where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/060ac94065cac9e3b53c2e6b9635d07… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/060ac94065cac9e3b53c2e6b9635d07… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Add nubOrd / nubOrdBy to Data.List and Data.List.NonEmpty
by Marge Bot (＠marge-bot) 22 Nov '25

22 Nov '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b7b7c049 by Andrew Lelechenko at 2025-11-21T21:04:01+00:00 Add nubOrd / nubOrdBy to Data.List and Data.List.NonEmpty As per https://github.com/haskell/core-libraries-committee/issues/336 - - - - - 22c7c804 by Marc Scholten at 2025-11-22T04:51:44-05:00 Fix haddock test runner to handle UTF-8 output xhtml 3000.4.0.0 now produces UTF-8 output instead of escaping non-ASCII characters. When using --test-accept it previously wrote files in the wrong encoding because they have not been decoded properly when reading the files. - - - - - 11 changed files: - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Data/List.hs - libraries/base/src/Data/List/NonEmpty.hs - + libraries/base/src/Data/List/NubOrdSet.hs - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - utils/haddock/haddock-test/src/Test/Haddock.hs Changes: ===================================== libraries/base/base.cabal.in ===================================== @@ -303,6 +303,7 @@ Library , GHC.JS.Foreign.Callback other-modules: + Data.List.NubOrdSet System.CPUTime.Unsupported System.CPUTime.Utils if os(windows) ===================================== libraries/base/changelog.md ===================================== @@ -10,6 +10,7 @@ * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350)) * Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339)) * Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335) + * Add `nubOrd` / `nubOrdBy` to `Data.List` and `Data.List.NonEmpty`. ([CLC proposal #336](https://github.com/haskell/core-libraries-committee/issues/336)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/Data/List.hs ===================================== @@ -136,7 +136,11 @@ module Data.List unlines, unwords, -- ** \"Set\" operations + -- | Consider using @Data.Set@ from @containers@ package, + -- which offers a much wider and often more efficient range + -- of operations on sets. nub, + nubOrd, delete, (\\), union, @@ -157,6 +161,7 @@ module Data.List -- *** User-supplied equality (replacing an @Eq@ context) -- | The predicate is assumed to define an equivalence. nubBy, + nubOrdBy, deleteBy, deleteFirstsBy, unionBy, @@ -180,12 +185,14 @@ module Data.List ) where import GHC.Internal.Data.Bool (otherwise) +import GHC.Internal.Data.Function (const) import GHC.Internal.Data.List import GHC.Internal.Data.List.NonEmpty (NonEmpty(..)) -import GHC.Internal.Data.Ord (Ordering(..), (<), (>)) +import GHC.Internal.Data.Ord (Ord, compare, Ordering(..), (<), (>)) import GHC.Internal.Int (Int) import GHC.Internal.Num ((-)) import GHC.List (build) +import qualified Data.List.NubOrdSet as NubOrdSet inits1, tails1 :: [a] -> [NonEmpty a] @@ -282,3 +289,25 @@ compareLength xs n (\m -> if m > 0 then LT else EQ) xs n + +-- | Same as 'nub', but asymptotically faster, taking only /O/(/n/ log /d/) time, +-- where /d/ is the number of distinct elements in the list. +-- +-- @since 4.23.0.0 +nubOrd :: Ord a => [a] -> [a] +nubOrd = nubOrdBy compare +{-# INLINE nubOrd #-} + +-- | Overloaded version of 'Data.List.nubOrd'. +-- +-- The supplied comparison relation is supposed to be reflexive, transitive +-- and antisymmetric, same as for 'sortBy'. +-- +-- @since 4.23.0.0 +nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a] +nubOrdBy cmp xs = foldr + (\x cont seen -> if NubOrdSet.member cmp x seen then cont seen else x : cont (NubOrdSet.insert cmp x seen)) + (const []) + xs + NubOrdSet.empty +{-# INLINE nubOrdBy #-} ===================================== libraries/base/src/Data/List/NonEmpty.hs ===================================== @@ -94,7 +94,9 @@ module Data.List.NonEmpty ( , isPrefixOf -- :: Eq a => [a] -> NonEmpty a -> Bool -- * \"Set\" operations , nub -- :: Eq a => NonEmpty a -> NonEmpty a + , nubOrd -- :: Ord a => NonEmpty a -> NonEmpty a , nubBy -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a + , nubOrdBy -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -- * Indexing streams , (!!) -- :: NonEmpty a -> Int -> a -- * Zipping and unzipping streams @@ -119,6 +121,7 @@ import qualified Prelude import Control.Applicative (Applicative (..), Alternative (many)) import qualified Data.List as List +import qualified Data.List.NubOrdSet as NubOrdSet import qualified Data.Maybe as List (mapMaybe) import GHC.Internal.Data.Foldable hiding (length, toList) import qualified GHC.Internal.Data.Foldable as Foldable @@ -568,6 +571,13 @@ unzip ((a, b) :| asbs) = (a :| as, b :| bs) -- (The name 'nub' means \'essence\'.) -- It is a special case of 'nubBy', which allows the programmer to -- supply their own inequality test. +-- +-- This function knows too little about the elements to be efficient. +-- Its asymptotic complexity is +-- /O/(/n/ ⋅ /d/), where /d/ is the number of distinct elements in the list. +-- +-- If there exists @instance Ord a@, it's faster to use 'Data.List.NonEmpty.nubOrd'. +-- nub :: Eq a => NonEmpty a -> NonEmpty a nub = nubBy (==) @@ -577,6 +587,25 @@ nub = nubBy (==) nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a nubBy eq (a :| as) = a :| List.nubBy eq (List.filter (\b -> not (eq a b)) as) +-- | Same as 'nub', but asymptotically faster, taking only /O/(/n/ log /d/) time. +-- where /d/ is the number of distinct elements in the list. +-- +-- @since 4.23.0.0 +nubOrd :: Ord a => NonEmpty a -> NonEmpty a +nubOrd = nubOrdBy compare +{-# INLINE nubOrd #-} + +-- | Overloaded version of 'Data.List.NonEmpty.nubOrd'. +-- +-- @since 4.23.0.0 +nubOrdBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a +nubOrdBy cmp (y :| ys) = y :| foldr + (\x cont seen -> if NubOrdSet.member cmp x seen then cont seen else x : cont (NubOrdSet.insert cmp x seen)) + (const []) + ys + (NubOrdSet.insert cmp y NubOrdSet.empty) +{-# INLINE nubOrdBy #-} + -- | 'transpose' for 'NonEmpty', behaves the same as 'GHC.Internal.Data.List.transpose' -- The rows/columns need not be the same length, in which case -- > transpose . transpose /= id ===================================== libraries/base/src/Data/List/NubOrdSet.hs ===================================== @@ -0,0 +1,81 @@ +-- This is an internal module with a naive set implementation, +-- solely for the purposes of `Data.List.{,NonEmpty.}nubOrd{,By}`. + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} + +module Data.List.NubOrdSet ( + NubOrdSet, + empty, + member, + insert, +) where + +import GHC.Internal.Data.Bool (Bool(..)) +import GHC.Internal.Data.Function ((.)) +import GHC.Internal.Data.Ord (Ordering(..)) + +-- | Implemented as a red-black tree, a la Okasaki. +data NubOrdSet a + = Empty + | NodeRed !(NubOrdSet a) !a !(NubOrdSet a) + | NodeBlack !(NubOrdSet a) !a !(NubOrdSet a) + +empty :: NubOrdSet a +empty = Empty + +member :: (a -> a -> Ordering) -> a -> NubOrdSet a -> Bool +member cmp = member' + where + member' !x = go + where + go = \case + Empty -> False + NodeRed left center right -> chooseWay left center right + NodeBlack left center right -> chooseWay left center right + + chooseWay left center right = case cmp x center of + LT -> go left + EQ -> True + GT -> go right +{-# INLINE member #-} + +insert :: (a -> a -> Ordering) -> a -> NubOrdSet a -> NubOrdSet a +insert cmp = insert' + where + insert' !x = blacken . go + where + go node = case node of + Empty -> NodeRed Empty x Empty + NodeRed left center right -> case cmp x center of + LT -> NodeRed (go left) center right + EQ -> node + GT -> NodeRed left center (go right) + NodeBlack left center right -> case cmp x center of + LT -> balanceBlackLeft (go left) center right + EQ -> node + GT -> balanceBlackRight left center (go right) + + blacken node = case node of + Empty -> Empty + NodeRed left center right -> NodeBlack left center right + NodeBlack{} -> node +{-# INLINE insert #-} + +balanceBlackLeft :: NubOrdSet a -> a -> NubOrdSet a -> NubOrdSet a +balanceBlackLeft (NodeRed (NodeRed a b c) d e) f g = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackLeft (NodeRed a b (NodeRed c d e)) f g = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackLeft left center right = + NodeBlack left center right +{-# INLINE balanceBlackLeft #-} + +balanceBlackRight :: NubOrdSet a -> a -> NubOrdSet a -> NubOrdSet a +balanceBlackRight a b (NodeRed (NodeRed c d e) f g) = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackRight a b (NodeRed c d (NodeRed e f g)) = + NodeRed (NodeBlack a b c) d (NodeBlack e f g) +balanceBlackRight left center right = + NodeBlack left center right +{-# INLINE balanceBlackRight #-} ===================================== libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs ===================================== @@ -494,21 +494,16 @@ dropLengthMaybe (_:x') (_:y') = dropLengthMaybe x' y' isInfixOf :: (Eq a) => [a] -> [a] -> Bool isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) --- | $\mathcal{O}(n^2)$. The 'nub' function removes duplicate elements from a +-- | The 'nub' function removes duplicate elements from a -- list. In particular, it keeps only the first occurrence of each element. (The -- name 'nub' means \`essence\'.) It is a special case of 'nubBy', which allows -- the programmer to supply their own equality test. -- +-- This function knows too little about the elements to be efficient. +-- Its asymptotic complexity is +-- /O/(/n/ ⋅ /d/), where /d/ is the number of distinct elements in the list. -- --- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package --- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Con…) --- which takes only $\mathcal{O}(n \log d)$ time where `d` is the number of --- distinct elements in the list. --- --- Another approach to speed up 'nub' is to use --- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes $\mathcal{O}(n \log n)$ time, requires @instance Ord a@ and doesn't --- preserve the order. +-- If there exists @instance Ord a@, it's faster to use 'Data.List.nubOrd'. -- -- ==== __Examples__ -- ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -1379,6 +1379,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1473,6 +1475,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== utils/haddock/haddock-test/src/Test/Haddock.hs ===================================== @@ -8,7 +8,6 @@ module Test.Haddock ) where import Control.Monad -import qualified Data.ByteString.Char8 as BS import qualified Data.Map.Strict as Map import Data.Foldable (for_) import Data.Maybe @@ -211,7 +210,7 @@ checkFile cfg file = do ccfg = cfgCheckConfig cfg dcfg = cfgDirConfig cfg --- We use ByteString here to ensure that no lazy I/O is performed. +-- We use readFile' here to ensure that no lazy I/O is performed. -- This way to ensure that the reference file isn't held open in -- case after `diffFile` (which is problematic if we need to rewrite -- the reference file in `maybeAcceptFile`) @@ -219,8 +218,8 @@ checkFile cfg file = do -- | Read the reference artifact for a test readRef :: Config c -> FilePath -> IO (Maybe c) readRef cfg file = - ccfgRead ccfg . BS.unpack - <$> BS.readFile (refFile dcfg file) + ccfgRead ccfg + <$> readFile' (refFile dcfg file) where ccfg = cfgCheckConfig cfg dcfg = cfgDirConfig cfg @@ -228,8 +227,8 @@ readRef cfg file = -- | Read (and clean) the test output artifact for a test readOut :: Config c -> (DirConfig -> FilePath) -> FilePath -> IO c readOut cfg dcfgDir file = do - res <- fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack - <$> BS.readFile outFile + res <- fmap (ccfgClean ccfg file) . ccfgRead ccfg + <$> readFile' outFile case res of Just out -> return out Nothing -> error $ "Failed to parse output file: " ++ outFile View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f51b04530ad048c638e42f1df04d2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f51b04530ad048c638e42f1df04d2… You're receiving this email because of your account on gitlab.haskell.org.

1 0