[Git][ghc/ghc][wip/sjakobi/T27296-stable-simpl] 6 commits: Hadrian: convert env variable ACLOCAL_PATH to unix paths.

Simon Jakobi pushed to branch wip/sjakobi/T27296-stable-simpl at Glasgow Haskell Compiler / GHC Commits: a3b431f3 by David Eichmann at 2026-06-04T10:10:19+00:00 Hadrian: convert env variable ACLOCAL_PATH to unix paths. Convert ACLOCAL_PATH to a unix style path when invoking autoreconf. Autoreconf doesn't handle windows paths. See Note [Autoreconf unix paths from ACLOCAL_PATH]. Fixes #27311 - - - - - 18f6138a by Simon Jakobi at 2026-06-04T20:20:31-04:00 testsuite: Deduplicate --only test names config.only is assumed to be a set, but supplying --only overwrote it with the (list) argparse result, which can contain duplicates. When a test ran, config.only.remove(name) dropped only the first occurrence, so a duplicated name lingered and was later misreported as a "test not found" framework failure. Store it as a set instead. Fixes #27322 Co-Authored-By: Claude Opus 4.7 - - - - - 2f3cc9ff by Simon Jakobi at 2026-06-08T07:55:49-04:00 testsuite: detect fast bignum via ghc-internal, not removed ghc-bignum The ghc-bignum package was merged into ghc-internal, so the BIGNUM_GMP probe in test.mk ran `ghc-pkg field ghc-bignum exposed-modules`, which fails with "cannot find package ghc-bignum". That error went to stderr and leaked into the captured stderr of every makefile_test, causing spurious [bad stderr] failures across the suite. The probe also silently returned empty, so config.have_fast_bignum was wrongly False even on GMP builds. Probe ghc-internal's extra-libraries for the gmp library instead: the GMP backend module is an other-module (not exposed), but GMP_LIBS adds gmp to extra-libraries only on a GMP build, so this distinguishes the backends. Redirect stderr to keep any future missing-package error off the harness's stderr. This also removes a stale comment as per suggestion from hsyl20. Co-Authored-By: Claude Opus 4.7 - - - - - eb3bf6e7 by Alan Zimmerman at 2026-06-08T07:56:32-04:00 EPA: Rename Transform.anchorEof to addModuleCommentOrigDeltas This now matches what it actually does. - - - - - 7153ddec by Simon Jakobi at 2026-06-09T10:17:11+02:00 Add -dstable-core-dump-order for stable Core dump ordering (#27296) The order of top-level bindings in Core dumps (-ddump-simpl etc.) is the compiler's internal processing order, which is sensitive to Uniques. Uniques can shift whenever an unrelated upstream module changes, so the bindings get re-ordered and a textual diff of two dumps fails to line up the real changes. This adds an opt-in flag -dstable-core-dump-order that reorders the top-level bindings of Core dumps routed through dumpPassResult into a stable, unique-independent order: by source location, then a $-rank so a derived $w/$s binder sorts before its origin (mirroring GHC's default dependency order, where the wrapper calls the worker), then the OccName. Workers and specialisations inherit their origin's source span, so they cluster next to the binding they come from; anonymous floats (noSrcSpan) sort to the end; Rec groups are kept intact. Only top-level bindings are reordered; nested bindings are left as-is. The default order is retained as it is useful when debugging the compiler itself. The ordering is unique-independent, so two dumps line up across rebuilds. See Note [Stable Core dump order] in GHC.Core.Ppr. Adds test T27296, a small Data.Map-style module whose binders GHC emits in a non-source order by default, asserting they come out stably ordered under the flag. Co-Authored-By: Claude Opus 4.7 - - - - - 6e9658ab by Simon Jakobi at 2026-06-09T10:30:20+02:00 Stabilise anonymous float ordering in untidied Core dumps Anonymous floats are all built with OccName "lvl" and noSrcSpan (newLvlVar), so the source-span/name sort key is identical for every one of them; sortOn then falls back to the unique-driven input order -- the very churn -dstable-core-dump-order is meant to remove. (Tidied dumps like -ddump-simpl are unaffected, as tidy gives the floats distinct names lvl, lvl1, ...) Add a content-based, unique-independent tie-break (rhsKey): the floated literal, if any, then the RHS size statistics. Add test T27296b pinning the float ordering in an untidied -ddump-float-out dump. It is a makefile_test that seds the dump down to just the bindings (collapsing each pass header to a bare "Float out" separator and dropping the FOS config / size lines), so the six lvl floats are asserted to come out ordered by literal value. Co-Authored-By: Claude Opus 4.7 - - - - - 21 changed files: - boot - + changelog.d/stable-core-dump-order-27296 - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/debugging.rst - hadrian/src/Hadrian/Oracles/Path.hs - hadrian/src/Rules/BinaryDist.hs - testsuite/driver/runtests.py - testsuite/mk/test.mk - testsuite/tests/simplCore/should_compile/Makefile - + testsuite/tests/simplCore/should_compile/T27296.hs - + testsuite/tests/simplCore/should_compile/T27296.stdout - + testsuite/tests/simplCore/should_compile/T27296b.hs - + testsuite/tests/simplCore/should_compile/T27296b.stdout - testsuite/tests/simplCore/should_compile/all.T - utils/check-exact/Main.hs - utils/check-exact/Transform.hs Changes: ===================================== boot ===================================== @@ -52,9 +52,8 @@ def autoreconf(): # Run autoreconf on everything that needs it. processes = {} if os.name == 'nt': - # Get the normalized ACLOCAL_PATH for Windows - # This is necessary since on Windows this will be a Windows - # path, which autoreconf doesn't know doesn't know how to handle. + # Convert ACLOCAL_PATH env variable to unix style paths on Windows + # See Note [Autoreconf unix paths from ACLOCAL_PATH] ac_local = os.getenv('ACLOCAL_PATH', '') ac_local_arg = re.sub(r';', r':', ac_local) ac_local_arg = re.sub(r'\\', r'/', ac_local_arg) ===================================== changelog.d/stable-core-dump-order-27296 ===================================== @@ -0,0 +1,4 @@ +section: compiler +synopsis: Add :ghc-flag:`-dstable-core-dump-order`, a debugging flag that prints top-level Core bindings in a stable, source-location-based order that does not depend on uniques, making intermediate-compiler dumps (e.g. with :ghc-flag:`-ddump-simpl` or :ghc-flag:`-dverbose-core2core`) easier to diff. This affects only the compiler's intermediate output; it does not change generated code. +issues: #27296 +mrs: !16143 ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -327,12 +327,17 @@ dumpPassResult logger dump_core_sizes name_ppr_ctx mb_flag hdr extra_info binds where size_doc = sep [text "Result size of" <+> text hdr, nest 2 (equals <+> ppr (coreBindsStats binds))] + -- See Note [Stable Core dump order] in GHC.Core.Ppr + binds' | sdocStableCoreDumpOrder (log_default_dump_context (logFlags logger)) + = sortCoreBindingsForDump binds + | otherwise = binds + dump_doc = vcat [ nest 2 extra_info , size_doc , blankLine , if dump_core_sizes - then pprCoreBindingsWithSize binds - else pprCoreBindings binds + then pprCoreBindingsWithSize binds' + else pprCoreBindings binds' , ppUnless (null rules) pp_rules ] pp_rules = vcat [ blankLine , text "------ Local rules for imported ids --------" ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Core.Ppr ( pprCoreExpr, pprParendExpr, pprCoreBinding, pprCoreBindings, pprCoreAlt, pprCoreBindingWithSize, pprCoreBindingsWithSize, + sortCoreBindingsForDump, pprCoreBinder, pprCoreBinders, pprId, pprIds, pprRule, pprRules, pprOptCo, pprOcc, pprOccWithTick @@ -27,10 +28,10 @@ module GHC.Core.Ppr ( import GHC.Prelude import GHC.Core -import GHC.Core.Stats (exprStats) +import GHC.Core.Stats (CoreStats(..), exprStats) import GHC.Types.Fixity (LexicalFixity(..)) -import GHC.Types.Literal( pprLiteral ) -import GHC.Types.Name( pprInfixName, pprPrefixName ) +import GHC.Types.Literal( Literal, pprLiteral ) +import GHC.Types.Name( getOccString, getSrcSpan, pprInfixName, pprPrefixName ) import GHC.Types.Var import GHC.Types.Id import GHC.Types.Id.Info @@ -44,9 +45,13 @@ import GHC.Core.Coercion import GHC.Types.Basic import GHC.Utils.Misc import GHC.Utils.Outputable -import GHC.Types.SrcLoc ( pprUserRealSpan ) +import GHC.Utils.Panic (panic) +import GHC.Types.SrcLoc ( SrcSpan(..), pprUserRealSpan, srcSpanStartCol + , srcSpanStartLine ) import GHC.Types.Tickish +import Data.List ( sortOn ) + {- ************************************************************************ * * @@ -71,6 +76,115 @@ pprCoreBindingWithSize :: CoreBind -> SDoc pprCoreBindingsWithSize = pprTopBinds sizeAnn pprCoreBindingWithSize = pprTopBind sizeAnn +{- Note [Stable Core dump order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The order of top-level bindings in a Core dump (-ddump-simpl etc.) is the +compiler's internal processing order, which is sensitive to Uniques. Uniques +can shift whenever an unrelated upstream module changes, so the bindings get +re-ordered and a textual diff of two dumps fails to line up the real changes +(#27296). + +With -dstable-core-dump-order we reorder the top-level bindings at dump time into +a stable order. 'sortCoreBindingsForDump' sorts by a key that is *independent of +Uniques*, so two dumps line up across rebuilds. The sort key is: + + 1. the binder's source span (real spans in source order; noSrcSpan last). + Workers and specialisations inherit their origin's source span (see + 'mkWorkerId' and 'newSpecIdSM'), so they cluster next to the binding they + come from. + 2. a "$-rank" so that within one source span the compiler-derived binders sort + *before* the origin they come from (e.g. @$wfoo@ before @foo@), mirroring + GHC's default dependency order (the wrapper calls the worker, so the worker + comes first; specialisations likewise precede their origin). We rank by + whether the OccName *contains* a '$', which marks a derived binder: a worker + is @$wfoo@, but a call-site specialisation is tidied to @bar_$sfoo@ (no + leading '$'), so a leading-'$' test would miss it. + 3. the OccName string, as a lexical, deterministic tie-break. + 4. a content-based tie-break on the right-hand side ('rhsKey'): the floated + literal, if any, then the RHS size statistics. This matters for the + anonymous floats: 'newLvlVar' builds them all with OccName "lvl" and + noSrcSpan, so keys 1-3 are identical and without it their order would fall + back to the Unique-driven input order -- the churn we set out to remove. + (Tidied dumps like -ddump-simpl give the floats distinct names lvl, + lvl1, ...; this additionally stabilises untidied dumps such as + -ddump-simpl-iterations.) It is only a best-effort tie-break -- RHSs + agreeing on both components keep their input order -- and Unique-independent + for the numeric CAFs we target (a rubbish literal is the exception: its + 'cmpLit' falls back to the Unique-dependent 'nonDetCmpType'). + +Recursive groups are never split: a 'Rec' is one 'CoreBind', placed as a unit by +its earliest-source member, with its members sorted by the same key. + +Only *top-level* bindings (and the members of a top-level 'Rec') are reordered. +Bindings nested inside a right-hand side (a 'let'/'letrec' within an expression) +are left in their original order: their position in the dump is fixed by the +surrounding expression rather than chosen by a Unique-keyed sort, so they don't +suffer the cross-module churn this flag addresses. + +-dstable-core-dump-order is opt-in; the default order is retained because it is +useful for debugging the compiler itself. +-} + +-- | The sort key for one top-level binder. The trailing 'RhsKey' is a +-- content-based tiebreak, used only when two binders agree on everything +-- before it. See Note [Stable Core dump order]. +type DumpSortKey = + ( Int -- source-span bucket: 0 = real span, 1 = noSrcSpan (sorts last) + , Int -- source-span start line + , Int -- source-span start column + , Int -- dollar-rank: 0 = derived ($w/$s) binder, 1 = its origin + , String -- the OccName string, a lexical tiebreak + , RhsKey -- content-based tiebreak (see 'rhsKey') + ) + +-- | Reorder a 'CoreProgram' into a stable, source-location-driven order for +-- dumping. See Note [Stable Core dump order]. Used by 'dumpPassResult' when +-- -dstable-core-dump-order is enabled. +sortCoreBindingsForDump :: CoreProgram -> CoreProgram +sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers + where + sortRecMembers (Rec prs) = Rec (sortOn (uncurry elemKey) prs) + sortRecMembers b = b + + -- 'sortRecMembers' runs first, so a 'Rec' is already sorted by 'elemKey' + -- when 'bindKey' sees it; its first member is therefore the minimum key. + bindKey :: CoreBind -> DumpSortKey + bindKey (NonRec b rhs) = elemKey b rhs + bindKey (Rec ((b,rhs):_)) = elemKey b rhs + bindKey (Rec []) = panic "sortCoreBindingsForDump: empty Rec" + + elemKey :: CoreBndr -> CoreExpr -> DumpSortKey + elemKey b rhs = (bucket, line, col, dollar_rank, s, rhsKey rhs) + where + s = getOccString b + (bucket, line, col) = case getSrcSpan b of + RealSrcSpan rs _ -> (0, srcSpanStartLine rs, srcSpanStartCol rs) + _ -> (1, 0, 0) -- noSrcSpan: sort last + -- A '$' anywhere in a tidied top-level OccName marks a compiler-derived + -- binder ($wfoo, but also call-site specialisations tidied to + -- bar_$sfoo); rank those before their origin within a shared source span, + -- mirroring GHC's default dependency order (the wrapper calls the worker, + -- so the worker comes first). + dollar_rank | '$' `elem` s = 0 + | otherwise = 1 + +-- | A content-based tie-break on a binder's right-hand side: see point 4 of +-- Note [Stable Core dump order]. +type RhsKey = + ( Maybe Literal -- the floated literal, if any (Nothing sorts first) + , (Int, Int, Int, Int, Int) -- exprStats counts: terms, types, coercions, value binds, join binds + ) + +rhsKey :: CoreExpr -> RhsKey +rhsKey rhs = (litOf rhs, statsTuple (exprStats rhs)) + where + statsTuple (CS tm ty co vb jb) = (tm, ty, co, vb, jb) + litOf (Lit l) = Just l + litOf (App f a) = case a of { Lit l -> Just l; _ -> litOf f } + litOf (Cast e _) = litOf e + litOf (Tick _ e) = litOf e + litOf _ = Nothing + instance OutputableBndr b => Outputable (Bind b) where ppr bind = ppr_bind noAnn bind ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1594,6 +1594,7 @@ initSDocContext dflags style = SDC , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags + , sdocStableCoreDumpOrder = gopt Opt_StableCoreDumpOrder dflags , sdocErrorSpans = gopt Opt_ErrorSpans dflags , sdocStarIsType = xopt LangExt.StarIsType dflags , sdocLinearTypes = xopt LangExt.LinearTypes dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -859,6 +859,10 @@ data GeneralFlag | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps | Opt_SuppressCoreSizes -- ^ Suppress per binding Core size stats in dumps + -- | Reorder top-level bindings in Core dumps into a stable, diffable order. + -- See Note [Stable Core dump order] in GHC.Core.Ppr. + | Opt_StableCoreDumpOrder + -- Error message suppression | Opt_ShowErrorContext ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2468,6 +2468,7 @@ dFlagsDeps = [ flagSpec "ppr-case-as-let" Opt_PprCaseAsLet, depFlagSpec' "ppr-ticks" Opt_PprShowTicks (\turn_on -> useInstead "-d" "suppress-ticks" (not turn_on)), + flagSpec "stable-core-dump-order" Opt_StableCoreDumpOrder, flagSpec "suppress-ticks" Opt_SuppressTicks, depFlagSpec' "suppress-stg-free-vars" Opt_SuppressStgExts (useInstead "-d" "suppress-stg-exts"), ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -422,6 +422,7 @@ data SDocContext = SDC , sdocSuppressModulePrefixes :: !Bool , sdocSuppressStgExts :: !Bool , sdocSuppressStgReps :: !Bool + , sdocStableCoreDumpOrder :: !Bool , sdocErrorSpans :: !Bool , sdocStarIsType :: !Bool , sdocLinearTypes :: !Bool @@ -490,6 +491,7 @@ defaultSDocContext = SDC , sdocSuppressModulePrefixes = False , sdocSuppressStgExts = False , sdocSuppressStgReps = True + , sdocStableCoreDumpOrder = False , sdocErrorSpans = False , sdocStarIsType = False , sdocLinearTypes = False ===================================== docs/users_guide/debugging.rst ===================================== @@ -959,6 +959,33 @@ parts that you are not interested in. has shown you where to look, you can try again without :ghc-flag:`-dsuppress-uniques` +.. ghc-flag:: -dstable-core-dump-order + :shortdesc: Reorder top-level bindings in Core dumps into a stable, + diffable order + :type: dynamic + :reverse: -dno-stable-core-dump-order + :category: verbosity + + :since: 10.2.1 + + Normally the order of top-level bindings in a Core dump (such as the + output of :ghc-flag:`-ddump-simpl`) reflects the compiler's internal + processing order, which depends on ``Unique`` values. Those uniques can + shift whenever an unrelated upstream module changes, so the bindings get + re-ordered and a textual ``diff`` of two dumps fails to line up the real + changes. + + This flag is opt-in and reorders the top-level bindings of Core dumps that + go through the pass-result printer (e.g. :ghc-flag:`-ddump-simpl`, + :ghc-flag:`-ddump-prep`, :ghc-flag:`-ddump-ds`, + :ghc-flag:`-ddump-simpl-iterations`) into a stable, source-location-driven + order that does not depend on uniques. + + It is intended to be combined with :ghc-flag:`-dsuppress-uniques` when + diffing two dumps, but because the ordering does not depend on uniques the + output is also more diffable without it. The default (in-compiler) order is + retained because it is useful when debugging the compiler itself. + .. ghc-flag:: -dsuppress-idinfo :shortdesc: Suppress extended information about identifiers where they are bound ===================================== hadrian/src/Hadrian/Oracles/Path.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE TypeFamilies #-} module Hadrian.Oracles.Path ( - lookupInPath, fixAbsolutePathOnWindows, pathOracle + lookupInPath, fixAbsolutePathOnWindows, fixUnixPathsOnWindows, + pathOracle ) where import Control.Monad @@ -33,6 +34,14 @@ fixAbsolutePathOnWindows path = else return path +-- | Fix a unix path list on Windows: +-- * "C:\\foo\\bar;C:\\msys2\\bin" => "/c/foo/bar:/c/msys2/bin" +fixUnixPathsOnWindows :: FilePath -> Action FilePath +fixUnixPathsOnWindows paths = + if isWindows + then askOracle $ UnixPathList paths + else return paths + newtype LookupInPath = LookupInPath String deriving (Binary, Eq, Hashable, NFData, Show) type instance RuleResult LookupInPath = String @@ -41,6 +50,10 @@ newtype WindowsPath = WindowsPath FilePath deriving (Binary, Eq, Hashable, NFData, Show) type instance RuleResult WindowsPath = String +newtype UnixPathList = UnixPathList FilePath + deriving (Binary, Eq, Hashable, NFData, Show) +type instance RuleResult UnixPathList = String + -- | Oracles for looking up paths. These are slow and require caching. pathOracle :: Rules () pathOracle = do @@ -50,6 +63,12 @@ pathOracle = do putVerbose $ "| Windows path mapping: " ++ path ++ " => " ++ windowsPath return windowsPath + void $ addOracleCache $ \(UnixPathList paths) -> do + Stdout out <- quietly $ cmd ["cygpath", "-p", "-u", paths] + let unixPaths = unifyPath $ dropWhileEnd isSpace out + putVerbose $ "| Unix path mapping: " ++ paths ++ " => " ++ unixPaths + return unixPaths + void $ addOracleCache $ \(LookupInPath name) -> do path <- liftIO getSearchPath exes <- liftIO (findExecutablesInDirectories path name) ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -3,18 +3,19 @@ module Rules.BinaryDist where import CommandLine import Context +import Data.Either +import qualified Data.Set as Set import Expression +import Hadrian.Oracles.Path (fixUnixPathsOnWindows) +import Oracles.Flavour import Oracles.Setting import Packages +import Rules.Generate (generateSettings) import Settings +import qualified System.Directory.Extra as IO import Settings.Program (programContext) import Target import Utilities -import qualified System.Directory.Extra as IO -import Data.Either -import qualified Data.Set as Set -import Oracles.Flavour -import Rules.Generate (generateSettings) {- Note [Binary distributions] @@ -343,7 +344,25 @@ bindistRules = do ghcRoot <- topDirectory copyFile (ghcRoot -/- "aclocal.m4") (ghcRoot -/- "distrib" -/- "aclocal.m4") copyDirectory (ghcRoot -/- "m4") (ghcRoot -/- "distrib") - buildWithCmdOptions [] $ + + -- Note [Autoreconf unix paths from ACLOCAL_PATH] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- On Windows, autoreconf fails when the ACLOCAL_PATH env variable contains Windows- + -- style paths. This happens because MSYS2 automatically converts env variables to + -- Windows-style paths. To fix this, we convert ACLOCAL_PATH back to Unix style. + -- This is done both in the boot Python script and here when building a bindist. + win_host <- isWinHost + env <- if not win_host + then pure [] + else do + aclocalPathMay <- getEnv "ACLOCAL_PATH" + case aclocalPathMay of + Nothing -> pure [] + Just aclocalPath -> do + unixAclocalPath <- fixUnixPathsOnWindows aclocalPath + pure [AddEnv "ACLOCAL_PATH" unixAclocalPath] + + buildWithCmdOptions env $ target (vanillaContext Stage1 ghc) (Autoreconf $ ghcRoot -/- "distrib") [] [] -- We clean after ourselves, moving the configure script we generated in -- our bindist dir ===================================== testsuite/driver/runtests.py ===================================== @@ -133,7 +133,7 @@ if args.unexpected_output_dir: config.unexpected_output_dir = Path(args.unexpected_output_dir) if args.only: - config.only = args.only + config.only = set(args.only) config.run_only_some_tests = True if args.skip: ===================================== testsuite/mk/test.mk ===================================== @@ -109,9 +109,11 @@ endif HAVE_GDB := $(shell if gdb --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) HAVE_READELF := $(shell if readelf --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) -# we need a better way to find which backend is selected and if --check flag is -# used -BIGNUM_GMP := $(shell "$(GHC_PKG)" field ghc-bignum exposed-modules | grep GMP) +# Detect whether the fast (GMP) bignum backend is in use. The GMP backend module +# in ghc-internal is hidden, so we look instead for the gmp library it links +# against: GMP_LIBS adds gmp to ghc-internal's extra-libraries only on a GMP +# build. +BIGNUM_GMP := $(shell "$(GHC_PKG)" field ghc-internal extra-libraries 2>/dev/null | grep gmp) ifeq "$(filter thr, $(GhcRTSWays))" "thr" RUNTEST_OPTS += -e config.ghc_with_threaded_rts=True ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -298,3 +298,36 @@ T17901: $(RM) -f T17901.o T17901.hi '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-uniques T17901.hs | grep 'wombat' # All three functions should get their case alternatives combined + +# Check -dstable-core-dump-order on a small Data.Map-style module. The +# sed allow-list prints, deduplicated, the top-level binders we care about in +# dump order. It inspects names only, so it is insensitive to unrelated +# Core-format churn. +# +# The allow-list covers one binder of each interesting category, so the test +# exercises the clustering of generated binders next to their origin: +# * derived instances ($fEqKey/$fOrdKey/$fOrdKey_$ccompare), +# * a call-site specialisation (findI_$slookupG, from lookupG's SPECIALISE), and +# * a recursive worker ($wrotate). +T27296: + $(RM) -f T27296.o T27296.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-uniques \ + -dsuppress-idinfo -dsuppress-module-prefixes -dno-typeable-binds \ + -dstable-core-dump-order T27296.hs 2> /dev/null \ + | sed -nE 's/^(\$$fEqKey|\$$fOrdKey|\$$fOrdKey_\$$ccompare|size|findI_\$$slookupG|lookupG|member|findI|\$$wrotate|rotate|insertG|insertManyI|insertTwoI|weight|balance|ratios|fromAscI)( .*)?$$/\1/p' \ + | uniq + +# See T27296b.hs for what this pins and why. -ddump-float-out is an untidied +# dump, so the sed normalises it down to just the bindings: it collapses each +# pass header to a bare "Float out" separator (dropping the noisy FOS config) +# and drops the "Result size" and "-- RHS size" lines. +T27296b: + $(RM) -f T27296b.o T27296b.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-float-out -dsuppress-uniques \ + -dsuppress-idinfo -dsuppress-module-prefixes -dno-typeable-binds \ + -dstable-core-dump-order T27296b.hs 2> /dev/null \ + | sed -E \ + -e '/^=+ Float out/,/=+$$/c\==================== Float out ====================' \ + -e '/^Result size of Float out/,/^ = \{terms/d' \ + -e '/^-- RHS size:/d' \ + | cat -s ===================================== testsuite/tests/simplCore/should_compile/T27296.hs ===================================== @@ -0,0 +1,87 @@ +{-# LANGUAGE BangPatterns #-} + +-- See Note [Stable Core dump order] in GHC.Core.Ppr. +-- +-- A small Data.Map-style module exercising the trickier parts of the stable +-- dump ordering. Under -O it produces, alongside the user functions: +-- * derived Eq/Ord instances for a custom Key type ($fEqKey/$fOrdKey/...), +-- * a call-site specialisation of lookupG (findI_$slookupG), and +-- * a worker/wrapper split of the recursive, strict rotate ($wrotate). +-- Each generated binder inherits its origin's source span, so the stable order +-- clusters it next to that origin. The source order is deliberately neither +-- alphabetical nor the default dump order (insertG forward-references balance), +-- so the test pins source-position ordering specifically. +module T27296 + ( Key(..), size, lookupG, member, findI, rotate, insertG, insertManyI + , insertTwoI, weight, balance, ratios, fromAscI ) + where + +-- A custom key with a derived Ord instance: the derived $fEqKey/$fOrdKey +-- binders inherit this declaration's source span, so they cluster here. +data Key = Key Int deriving (Eq, Ord) + +data Map k a = Tip | Bin !Int k a !(Map k a) !(Map k a) + +data Sizes = Sizes !Int !Int + +size :: Map k a -> Int +size Tip = 0 +size (Bin sz _ _ _ _) = sz + +lookupG :: Ord k => k -> Map k a -> Maybe a +lookupG _ Tip = Nothing +lookupG k (Bin _ kx x l r) = case compare k kx of + LT -> lookupG k l + GT -> lookupG k r + EQ -> Just x +{-# SPECIALISE lookupG :: Key -> Map Key a -> Maybe a #-} + +member :: Key -> Map Key a -> Bool +member k m = case lookupG k m of + Nothing -> False + Just _ -> True + +findI :: Key -> Map Key a -> a -> a +findI k m def = case lookupG k m of + Nothing -> def + Just v -> v + +-- rotate is recursive and strict in the product 'Sizes', so worker/wrapper +-- unboxes it into a recursive worker ($wrotate). The loop only repackages the +-- fields (no arithmetic), so the worker is stable across build flavours. +rotate :: Sizes -> [a] -> Sizes +rotate s [] = s +rotate (Sizes a b) (_:xs) = rotate (Sizes b a) xs + +-- insertG references 'balance', which is defined further down (forward ref). +insertG :: Ord k => k -> a -> Map k a -> Map k a +insertG k x Tip = Bin 1 k x Tip Tip +insertG k x (Bin sz kx kv l r) = case compare k kx of + LT -> balance kx kv (insertG k x l) r + GT -> balance kx kv l (insertG k x r) + EQ -> Bin sz k x l r +{-# SPECIALISE insertG :: Key -> a -> Map Key a -> Map Key a #-} + +insertManyI :: [(Key, a)] -> Map Key a -> Map Key a +insertManyI xs m0 = foldr (\(k, x) m -> insertG k x m) m0 xs + +insertTwoI :: Key -> Key -> a -> Map Key a +insertTwoI k1 k2 x = insertG k1 x (insertG k2 x Tip) + +-- weight unboxes the strict fields of Sizes -> worker/wrapper $wweight. +weight :: Sizes -> Int +weight (Sizes a b) = a * a + 3 * b * b + a * b + 1 + +balance :: k -> a -> Map k a -> Map k a -> Map k a +balance k x l r = Bin (weight (Sizes sl sr)) k x l r + where + sl = size l + sr = size r + +-- baseRatios is a closed constant under a lambda -> floated to a top-level lvl. +ratios :: Int -> [Int] +ratios n = map (n +) baseRatios + where baseRatios = [2, 3, 5, 7, 11, 13] + +fromAscI :: [(Key, a)] -> Map Key a +fromAscI = foldr (\(k, x) m -> insertG k x m) Tip ===================================== testsuite/tests/simplCore/should_compile/T27296.stdout ===================================== @@ -0,0 +1,17 @@ +$fEqKey +$fOrdKey +$fOrdKey_$ccompare +size +findI_$slookupG +lookupG +member +findI +$wrotate +rotate +insertG +insertManyI +insertTwoI +weight +balance +ratios +fromAscI ===================================== testsuite/tests/simplCore/should_compile/T27296b.hs ===================================== @@ -0,0 +1,21 @@ +-- See Note [Stable Core dump order] in GHC.Core.Ppr. +-- +-- Companion to T27296 that pins the ordering of *anonymous* top-level floats. +-- Under -O the boxed Int constants in sel's branches are floated to top level +-- as separate CAFs, all of which the compiler names "lvl" with noSrcSpan (see +-- newLvlVar). Before -dstable-core-dump-order their dump order was the +-- unique-driven processing order; the flag's content-based tie-break (rhsKey) +-- now orders them by literal value -- here 1000..6000, despite the scrambled +-- source order. This dump is intentionally *untidied* (-ddump-float-out), the +-- only place the "lvl" collision is observable; tidied dumps like -ddump-simpl +-- already give the floats distinct names (lvl, lvl1, ...). +module T27296b (sel) where + +{-# NOINLINE sel #-} +sel :: Int -> Int +sel 0 = 5000 +sel 1 = 1000 +sel 2 = 4000 +sel 3 = 2000 +sel 4 = 3000 +sel _ = 6000 ===================================== testsuite/tests/simplCore/should_compile/T27296b.stdout ===================================== @@ -0,0 +1,54 @@ + +==================== Float out ==================== + +sel :: Int -> Int +sel + = \ (ds :: Int) -> + case ds of { I# ds -> + case ds of { + __DEFAULT -> lvl; + 0# -> lvl; + 1# -> lvl; + 2# -> lvl; + 3# -> lvl; + 4# -> lvl + } + } + +lvl :: Int +lvl = I# 1000# + +lvl :: Int +lvl = I# 2000# + +lvl :: Int +lvl = I# 3000# + +lvl :: Int +lvl = I# 4000# + +lvl :: Int +lvl = I# 5000# + +lvl :: Int +lvl = I# 6000# + +==================== Float out ==================== + +$wsel :: Int# -> Int# +$wsel + = \ (ww :: Int#) -> + case ww of { + __DEFAULT -> 6000#; + 0# -> 5000#; + 1# -> 1000#; + 2# -> 4000#; + 3# -> 2000#; + 4# -> 3000# + } + +sel :: Int -> Int +sel + = \ (ds :: Int) -> + case ds of { I# ww -> case $wsel ww of ww { __DEFAULT -> I# ww } } + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -602,3 +602,5 @@ test('T25718b', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress test('T25718c', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all -dno-typeable-binds']) test('T19166', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all -dno-typeable-binds']) test('T27261', [extra_files(['T27261_aux.hs'])], multimod_compile, ['T27261', '-v0 -O']) +test('T27296', [], makefile_test, ['T27296']) +test('T27296b', [], makefile_test, ['T27296b']) ===================================== utils/check-exact/Main.hs ===================================== @@ -646,7 +646,7 @@ addLocaLDecl3 :: Changer addLocaLDecl3 libdir top = do Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") let - doAddLocal = replaceDecls (anchorEof lp) [parent',d2'] + doAddLocal = replaceDecls (addModuleCommentOrigDeltas lp) [parent',d2'] where lp = top (de1:d2:_) = hsDecls lp @@ -667,7 +667,7 @@ addLocaLDecl4 libdir lp = do Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") Right newSig <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int") let - doAddLocal = replaceDecls (anchorEof lp) (parent':ds) + doAddLocal = replaceDecls (addModuleCommentOrigDeltas lp) (parent':ds) where (parent:ds) = hsDecls (makeDeltaAst lp) @@ -781,7 +781,7 @@ rmDecl3 _libdir lp = do rmDecl4 :: Changer rmDecl4 _libdir lp = do let - doRmDecl = replaceDecls (anchorEof lp) [de1',sd1] + doRmDecl = replaceDecls (addModuleCommentOrigDeltas lp) [de1',sd1] where [de1] = hsDecls lp (de1',Just sd1) = modifyValD (getLocA de1) de1 $ \_m [sd1a,sd2] -> ===================================== utils/check-exact/Transform.hs ===================================== @@ -65,7 +65,7 @@ module Transform , balanceComments , balanceCommentsList , balanceCommentsListA - , anchorEof + , addModuleCommentOrigDeltas -- ** Managing lists, pure functions , captureOrderBinds @@ -724,8 +724,8 @@ balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) -- --------------------------------------------------------------------- -anchorEof :: ParsedSource -> ParsedSource -anchorEof (L l m@(HsModule (XModulePs an _lo _ _) _mn _exps _imps _decls)) = L l (m { hsmodExt = (hsmodExt m){ hsmodAnn = an' } }) +addModuleCommentOrigDeltas :: ParsedSource -> ParsedSource +addModuleCommentOrigDeltas (L l m@(HsModule (XModulePs an _lo _ _) _mn _exps _imps _decls)) = L l (m { hsmodExt = (hsmodExt m){ hsmodAnn = an' } }) where an' = addCommentOrigDeltasAnn an View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3c83b1d2794a55828567a5b471ea66d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3c83b1d2794a55828567a5b471ea66d... You're receiving this email because of your account on gitlab.haskell.org.