ghc-lib-parser 9.6.2.20231121 → 9.6.3.20231014

raw patch · 40 files changed

+650/−359 lines, 40 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• compiler/GHC/Cmm.hs +2/−3
• compiler/GHC/Cmm/CLabel.hs +6/−2
• compiler/GHC/Cmm/MachOp.hs +21/−1
• compiler/GHC/Core/Coercion.hs +6/−2
• compiler/GHC/Core/DataCon.hs +28/−11
• compiler/GHC/Core/Opt/Arity.hs +50/−37
• compiler/GHC/Core/Rules.hs +10/−4
• compiler/GHC/Core/Tidy.hs +2/−2
• compiler/GHC/Driver/Flags.hs +52/−14
• compiler/GHC/Driver/Session.hs +11/−5
• compiler/GHC/Hs/Utils.hs +1/−1
• compiler/GHC/Runtime/Heap/Layout.hs +3/−3
• compiler/GHC/Stg/Syntax.hs +1/−1
• compiler/GHC/StgToCmm/Config.hs +3/−2
• compiler/GHC/StgToCmm/Types.hs +47/−1
• compiler/GHC/Tc/Errors/Ppr.hs +9/−0
• compiler/GHC/Tc/Errors/Types.hs +14/−1
• compiler/GHC/Tc/Types.hs +6/−1
• compiler/GHC/Tc/Types/Constraint.hs +5/−4
• compiler/GHC/Types/Demand.hs +174/−162
• compiler/GHC/Types/Error/Codes.hs +2/−0
• compiler/GHC/Types/Id.hs +2/−0
• compiler/GHC/Types/Id/Info.hs +2/−1
• compiler/GHC/Types/Literal.hs +3/−2
• compiler/GHC/Types/RepType.hs +9/−5
• compiler/GHC/Utils/Binary.hs +2/−2
• compiler/GHC/Utils/TmpFs.hs +142/−69
• compiler/ghc.cabal +4/−4
• ghc-lib-parser.cabal +1/−1
• ghc-lib/stage0/compiler/build/GHC/Settings/Config.hs +1/−1
• ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs +4/−4
• ghc-lib/stage0/rts/build/include/ghcautoconf.h +6/−0
• ghc/ghc-bin.cabal +4/−4
• libraries/ghc-boot-th/ghc-boot-th.cabal +1/−1
• libraries/ghc-boot/ghc-boot.cabal +2/−2
• libraries/ghc-heap/ghc-heap.cabal +1/−1
• libraries/ghci/GHCi/FFI.hsc +8/−0
• libraries/ghci/GHCi/Message.hs +1/−1
• libraries/ghci/ghci.cabal +3/−3
• libraries/template-haskell/template-haskell.cabal +1/−1

@@ -229,16 +229,15 @@         -- place to convey this information from the code generator to         -- where we build the static closures in         -- GHC.Cmm.Info.Build.doSRTs.-    } deriving Eq+    } deriving (Eq, Ord)  instance OutputableP Platform CmmInfoTable where     pdoc = pprInfoTable - data ProfilingInfo   = NoProfilingInfo   | ProfilingInfo ByteString ByteString -- closure_type, closure_desc-  deriving Eq+  deriving (Eq, Ord) ----------------------------------------------------------------------------- --              Static Data -----------------------------------------------------------------------------

@@ -65,6 +65,7 @@         mkSMAP_DIRTY_infoLabel,         mkBadAlignmentLabel,         mkOutOfBoundsAccessLabel,+        mkMemcpyRangeOverlapLabel,         mkArrWords_infoLabel,         mkSRTInfoLabel, @@ -649,7 +650,8 @@     mkCAFBlackHoleInfoTableLabel,     mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,     mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel,-    mkOutOfBoundsAccessLabel, mkMUT_VAR_CLEAN_infoLabel :: CLabel+    mkOutOfBoundsAccessLabel, mkMemcpyRangeOverlapLabel,+    mkMUT_VAR_CLEAN_infoLabel :: CLabel mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel                                 = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData@@ -667,7 +669,8 @@ mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo mkBadAlignmentLabel             = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment")      CmmEntry-mkOutOfBoundsAccessLabel        = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") Nothing ForeignLabelInExternalPackage IsFunction+mkOutOfBoundsAccessLabel        = mkForeignLabel (fsLit "rtsOutOfBoundsAccess")  Nothing ForeignLabelInExternalPackage IsFunction+mkMemcpyRangeOverlapLabel       = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") Nothing ForeignLabelInExternalPackage IsFunction mkMUT_VAR_CLEAN_infoLabel       = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN")     CmmInfo  mkSRTInfoLabel :: Int -> CLabel@@ -1384,6 +1387,7 @@                    ordinary Haskell function of arity 1 that                    allocates a (Just x) box:                       Just = \x -> Just x+    Just_entry:    The entry code for the worker function     Just_closure:  The closure for this worker      Nothing_closure: a statically allocated closure for Nothing

@@ -51,6 +51,25 @@ assume that the code produced for a MachOp does not introduce new blocks. -} +-- Note [MO_S_MulMayOflo significant width]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- There are two interpretations in the code about what a multiplication+-- overflow exactly means:+--+-- 1. The result does not fit into the specified width (of type Width.)+-- 2. The result does not fit into a register.+--+-- (2) has some flaws: A following MO_Mul has a width, too. So MO_S_MulMayOflo+-- may signal no overflow, while MO_Mul truncates the result. There are+-- architectures with several register widths and it might be hard to decide+-- what's an overflow and what not. Both attributes can easily lead to subtle+-- bugs.+--+-- (1) has the benefit that its interpretation is completely independent of the+-- architecture. So, the mid-term plan is to migrate to this+-- interpretation/sematics.+ data MachOp   -- Integer operations (insensitive to signed/unsigned)   = MO_Add Width@@ -60,7 +79,8 @@   | MO_Mul Width                -- low word of multiply    -- Signed multiply/divide-  | MO_S_MulMayOflo Width       -- nonzero if signed multiply overflows+  | MO_S_MulMayOflo Width       -- nonzero if signed multiply overflows. See+                                -- Note [MO_S_MulMayOflo significant width]   | MO_S_Quot Width             -- signed / (same semantics as IntQuotOp)   | MO_S_Rem  Width             -- signed % (same semantics as IntRemOp)   | MO_S_Neg  Width             -- unary -

@@ -1155,8 +1155,12 @@     Pair ty1 ty2 = coercionKind co      go cs co-      | Just (ty, r) <- isReflCo_maybe co-      = Just (mkReflCo r (getNthFromType cs ty))+      | Just (ty, _co_role) <- isReflCo_maybe co+      = let new_role = coercionRole (SelCo cs co)+        in Just (mkReflCo new_role (getNthFromType cs ty))+        -- The role of the result (new_role) does not have to+        -- be equal to _co_role, the role of co, per Note [SelCo].+        -- This was revealed by #23938.      go SelForAll (ForAllCo _ kind_co _)       = Just kind_co

@@ -111,8 +111,8 @@ import Language.Haskell.Syntax.Module.Name  {--Data constructor representation-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note [Data constructor representation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following Haskell data type declaration          data T = T !Int ![Int]@@ -213,7 +213,7 @@  * The wrapper (if it exists) takes dcOrigArgTys as its arguments.   The worker takes dataConRepArgTys as its arguments-  If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys+  If the wrapper is absent, dataConRepArgTys is the same as dcOrigArgTys  * The 'NoDataConRep' case of DataConRep is important. Not only is it   efficient, but it also ensures that the wrapper is replaced by the@@ -586,12 +586,22 @@  Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~-dcSourceArity does not take constraints into account,-but dcRepArity does.  For example:+A `DataCon`'s source arity and core representation arity may differ:+`dcSourceArity` does not take constraints into account, but `dcRepArity` does.++The additional arguments taken into account by `dcRepArity` include quantified+dictionaries and coercion arguments, lifted and unlifted (despite the unlifted+coercion arguments having a zero-width runtime representation).+For example:    MkT :: Ord a => a -> T a     dcSourceArity = 1     dcRepArity    = 2 +   MkU :: (b ~ '[]) => U b+    dcSourceArity = 0+    dcRepArity    = 1++ Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A DataCon has two different sets of type variables:@@ -1030,7 +1040,7 @@         Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime+Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise).  This is how T would end up being used in STG post-unarise:@@ -1446,9 +1456,10 @@ dataConSourceArity :: DataCon -> Arity dataConSourceArity (MkData { dcSourceArity = arity }) = arity --- | Gives the number of actual fields in the /representation/ of the--- data constructor. This may be more than appear in the source code;--- the extra ones are the existentially quantified dictionaries+-- | Gives the number of value arguments (including zero-width coercions)+-- stored by the given `DataCon`'s worker in its Core representation. This may+-- differ from the number of arguments that appear in the source code; see also+-- Note [DataCon arities] dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity @@ -1457,8 +1468,14 @@ isNullarySrcDataCon :: DataCon -> Bool isNullarySrcDataCon dc = dataConSourceArity dc == 0 --- | Return whether there are any argument types for this 'DataCon's runtime representation type--- See Note [DataCon arities]+-- | Return whether this `DataCon`'s worker, in its Core representation, takes+-- any value arguments.+--+-- In particular, remember that we include coercion arguments in the arity of+-- the Core representation of the `DataCon` -- both lifted and unlifted+-- coercions, despite the latter having zero-width runtime representation.+--+-- See also Note [DataCon arities]. isNullaryRepDataCon :: DataCon -> Bool isNullaryRepDataCon dc = dataConRepArity dc == 0 

@@ -87,6 +87,8 @@ import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import Data.Maybe( isJust )+ {- ************************************************************************ *                                                                      *@@ -2303,18 +2305,6 @@      * `/\a. \x. f @(Maybe a) x -->  /\a. f @(Maybe a)`    See Note [Do not eta reduce PAPs] for why we insist on a trivial head. -2. Type and dictionary abstraction. Regardless of whether 'f' is a value, it-   is always sound to reduce /type lambdas/, thus:-        (/\a -> f a)  -->   f-   Moreover, we always want to, because it makes RULEs apply more often:-      This RULE:    `forall g. foldr (build (/\a -> g a))`-      should match  `foldr (build (/\b -> ...something complex...))`-   and the simplest way to do so is eta-reduce `/\a -> g a` in the RULE to `g`.--   The type checker can insert these eta-expanded versions,-   with both type and dictionary lambdas; hence the slightly-   ad-hoc (all ok_lam bndrs)- Of course, eta reduction is not always sound. See Note [Eta reduction soundness] for when it is. @@ -2353,7 +2343,7 @@ (checked in 'is_eta_reduction_sound' in 'tryEtaReduce', which focuses on the case where `e` is trivial): - A. It is sound to eta-reduce n arguments as long as n does not exceed the+(A) It is sound to eta-reduce n arguments as long as n does not exceed the     `exprArity` of `e`. (Needs Arity analysis.)     This criterion exploits information about how `e` is *defined*. @@ -2362,7 +2352,7 @@     By contrast, it would be *unsound* to eta-reduce 2 args, `\x y. e x y` to `e`:     `e 42` diverges when `(\x y. e x y) 42` does not. - S. It is sound to eta-reduce n arguments in an evaluation context in which all+(S) It is sound to eta-reduce n arguments in an evaluation context in which all     calls happen with at least n arguments. (Needs Strictness analysis.)     NB: This treats evaluations like a call with 0 args.     NB: This criterion exploits information about how `e` is *used*.@@ -2389,23 +2379,42 @@     See Note [Eta reduction based on evaluation context] for the implementation     details. This criterion is tested extensively in T21261. - R. Note [Eta reduction in recursive RHSs] tells us that we should not+(R) Note [Eta reduction in recursive RHSs] tells us that we should not     eta-reduce `f` in its own RHS and describes our fix.     There we have `f = \x. f x` and we should not eta-reduce to `f=f`. Which     might change a terminating program (think @f `seq` e@) to a non-terminating     one. - E. (See fun_arity in tryEtaReduce.) As a perhaps special case on the+(E) (See fun_arity in tryEtaReduce.) As a perhaps special case on the     boundary of (A) and (S), when we know that a fun binder `f` is in     WHNF, we simply assume it has arity 1 and apply (A).  Example:        g f = f `seq` \x. f x     Here it's sound eta-reduce `\x. f x` to `f`, because `f` can't be bottom     after the `seq`. This turned up in #7542. + T. If the binders are all type arguments, it's always safe to eta-reduce,+    regardless of the arity of f.+       /\a b. f @a @b  --> f++2. Type and dictionary abstraction. Regardless of whether 'f' is a value, it+   is always sound to reduce /type lambdas/, thus:+        (/\a -> f a)  -->   f+   Moreover, we always want to, because it makes RULEs apply more often:+      This RULE:    `forall g. foldr (build (/\a -> g a))`+      should match  `foldr (build (/\b -> ...something complex...))`+   and the simplest way to do so is eta-reduce `/\a -> g a` in the RULE to `g`.++   More debatably, we extend this to dictionary arguments too, because the type+   checker can insert these eta-expanded versions, with both type and dictionary+   lambdas; hence the slightly ad-hoc (all ok_lam bndrs).  That is, we eta-reduce+        \(d::Num a). f d   -->   f+   regardless of f's arity. Its not clear whether or not this is important, and+   it is not in general sound.  But that's the way it is right now.+ And here are a few more technical criteria for when it is *not* sound to eta-reduce that are specific to Core and GHC: - L. With linear types, eta-reduction can break type-checking:+(L) With linear types, eta-reduction can break type-checking:       f :: A ⊸ B       g :: A -> B       g = \x. f x@@ -2413,13 +2422,13 @@     complain that g and f don't have the same type. NB: Not unsound in the     dynamic semantics, but unsound according to the static semantics of Core. - J. We may not undersaturate join points.+(J) We may not undersaturate join points.     See Note [Invariants on join points] in GHC.Core, and #20599. - B. We may not undersaturate functions with no binding.+(B) We may not undersaturate functions with no binding.     See Note [Eta expanding primops]. - W. We may not undersaturate StrictWorkerIds.+(W) We may not undersaturate StrictWorkerIds.     See Note [CBV Function Ids] in GHC.Types.Id.Info.  Here is a list of historic accidents surrounding unsound eta-reduction:@@ -2663,20 +2672,25 @@     ok_fun (App fun (Type {})) = ok_fun fun     ok_fun (Cast fun _)        = ok_fun fun     ok_fun (Tick _ expr)       = ok_fun expr-    ok_fun (Var fun_id)        = is_eta_reduction_sound fun_id || all ok_lam bndrs+    ok_fun (Var fun_id)        = is_eta_reduction_sound fun_id     ok_fun _fun                = False      ---------------     -- See Note [Eta reduction soundness], this is THE place to check soundness!-    is_eta_reduction_sound fun =-      -- Don't eta-reduce in fun in its own recursive RHSs-      not (fun `elemUnVarSet` rec_ids)               -- criterion (R)-      -- Check that eta-reduction won't make the program stricter...-      && (fun_arity fun >= incoming_arity            -- criterion (A) and (E)-           || all_calls_with_arity incoming_arity)   -- criterion (S)-      -- ... and that the function can be eta reduced to arity 0-      -- without violating invariants of Core and GHC-      && canEtaReduceToArity fun 0 0              -- criteria (L), (J), (W), (B)+    is_eta_reduction_sound fun+      | fun `elemUnVarSet` rec_ids          -- Criterion (R)+      = False -- Don't eta-reduce in fun in its own recursive RHSs++      | cantEtaReduceFun fun                -- Criteria (L), (J), (W), (B)+      = False -- Function can't be eta reduced to arity 0+              -- without violating invariants of Core and GHC++      | otherwise+      = -- Check that eta-reduction won't make the program stricter...+        fun_arity fun >= incoming_arity          -- Criterion (A) and (E)+        || all_calls_with_arity incoming_arity   -- Criterion (S)+        || all ok_lam bndrs                      -- Criterion (T)+     all_calls_with_arity n = isStrict (fst $ peelManyCalls n eval_sd)        -- See Note [Eta reduction based on evaluation context] @@ -2726,19 +2740,18 @@      ok_arg _ _ _ _ = Nothing --- | Can we eta-reduce the given function to the specified arity?+-- | Can we eta-reduce the given function -- See Note [Eta reduction soundness], criteria (B), (J), (W) and (L).-canEtaReduceToArity :: Id -> JoinArity -> Arity -> Bool-canEtaReduceToArity fun dest_join_arity dest_arity =-  not $-        hasNoBinding fun -- (B)+cantEtaReduceFun :: Id -> Bool+cantEtaReduceFun fun+  =    hasNoBinding fun -- (B)        -- Don't undersaturate functions with no binding. -    ||  ( isJoinId fun && dest_join_arity < idJoinArity fun ) -- (J)+    ||  isJoinId fun    -- (J)        -- Don't undersaturate join points.        -- See Note [Invariants on join points] in GHC.Core, and #20599 -    || ( dest_arity < idCbvMarkArity fun ) -- (W)+    || (isJust (idCbvMarks_maybe fun)) -- (W)        -- Don't undersaturate StrictWorkerIds.        -- See Note [CBV Function Ids] in GHC.Types.Id.Info. 

@@ -886,9 +886,6 @@ see `init_menv` in `matchN`. -} -rvInScopeEnv :: RuleMatchEnv -> InScopeEnv-rvInScopeEnv renv = ISE (rnInScopeSet (rv_lcl renv)) (rv_unf renv)- -- * The domain of the TvSubstEnv and IdSubstEnv are the template --   variables passed into the match. --@@ -1105,7 +1102,16 @@  ------------------------  Lambdas --------------------- match renv subst (Lam x1 e1) e2 mco-  | Just (x2, e2', ts) <- exprIsLambda_maybe (rvInScopeEnv renv) (mkCastMCo e2 mco)+  | let casted_e2 = mkCastMCo e2 mco+        in_scope = extendInScopeSetSet (rnInScopeSet (rv_lcl renv))+                                       (exprFreeVars casted_e2)+        in_scope_env = ISE in_scope (rv_unf renv)+        -- extendInScopeSetSet: The InScopeSet of rn_env is not necessarily+        -- a superset of the free vars of e2; it is only guaranteed a superset of+        -- applyng the (rnEnvR rn_env) substitution to e2. But exprIsLambda_maybe+        -- wants an in-scope set that includes all the free vars of its argument.+        -- Hence adding adding (exprFreeVars casted_e2) to the in-scope set (#23630)+  , Just (x2, e2', ts) <- exprIsLambda_maybe in_scope_env casted_e2     -- See Note [Lambdas in the template]   = let renv'  = rnMatchBndr2 renv x1 x2         subst' = subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts }

@@ -82,7 +82,7 @@ -- This means the code generator can get the full calling convention by only looking at the function -- itself without having to inspect the RHS. ----- The actual logic is in tidyCbvInfo and takes:+-- The actual logic is in computeCbvInfo and takes: -- * The function id -- * The functions rhs -- And gives us back the function annotated with the marks.@@ -169,7 +169,7 @@                -- seqList: avoid retaining the original rhs               | otherwise-             = -- pprTraceDebug "tidyCbvInfo: Worker seems to take unboxed tuple/sum types!"+             = -- pprTraceDebug "computeCbvInfo: Worker seems to take unboxed tuple/sum types!"                --    (ppr fun_id <+> ppr rhs)                asNonWorkerLikeId fun_id 

@@ -5,6 +5,7 @@    , GeneralFlag(..)    , Language(..)    , optimisationFlags+   , codeGenFlags     -- * Warnings    , WarningFlag(..)@@ -149,6 +150,7 @@    | Opt_D_no_debug_output    | Opt_D_dump_faststrings    | Opt_D_faststring_stats+   | Opt_D_ipe_stats    deriving (Eq, Show, Enum)  -- | Helper function to query whether a given `DumpFlag` is enabled or not.@@ -211,6 +213,8 @@     | Opt_DistinctConstructorTables    | Opt_InfoTableMap+   | Opt_InfoTableMapWithFallback+   | Opt_InfoTableMapWithStack     | Opt_WarnIsError                    -- -Werror; makes warnings fatal    | Opt_ShowWarnGroups                 -- Show the group a warning belongs to@@ -246,6 +250,7 @@    | Opt_Specialise    | Opt_SpecialiseAggressively    | Opt_CrossModuleSpecialise+   | Opt_PolymorphicSpecialisation    | Opt_InlineGenerics    | Opt_InlineGenericsAggressively    | Opt_StaticArgumentTransformation@@ -467,15 +472,11 @@    | Opt_G_NoOptCoercion    deriving (Eq, Show, Enum) --- Check whether a flag should be considered an "optimisation flag"--- for purposes of recompilation avoidance (see--- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is--- not a guarantee that the flag has no other effect. We could, and--- perhaps should, separate out the flags that have some minor impact on--- program semantics and/or error behavior (e.g., assertions), but--- then we'd need to go to extra trouble (and an additional flag)--- to allow users to ignore the optimisation level even though that--- means ignoring some change.+-- | The set of flags which affect optimisation for the purposes of+-- recompilation avoidance. Specifically, these include flags which+-- affect code generation but not the semantics of the program.+--+-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags) optimisationFlags :: EnumSet GeneralFlag optimisationFlags = EnumSet.fromList    [ Opt_CallArity@@ -507,16 +508,12 @@    , Opt_EnableRewriteRules    , Opt_RegsGraph    , Opt_RegsIterative-   , Opt_PedanticBottoms    , Opt_LlvmTBAA-   , Opt_LlvmFillUndefWithGarbage    , Opt_IrrefutableTuples    , Opt_CmmSink    , Opt_CmmElimCommonBlocks    , Opt_AsmShortcutting-   , Opt_OmitYields    , Opt_FunToThunk-   , Opt_DictsStrict    , Opt_DmdTxDictSel    , Opt_Loopification    , Opt_CfgBlocklayout@@ -525,8 +522,49 @@    , Opt_WorkerWrapper    , Opt_WorkerWrapperUnlift    , Opt_SolveConstantDicts+   ]++-- | The set of flags which affect code generation and can change a program's+-- runtime behavior (other than performance). These include flags which affect:+--+--  * user visible debugging information (e.g. info table provenance)+--  * the ability to catch runtime errors (e.g. -fignore-asserts)+--  * the runtime result of the program (e.g. -fomit-yields)+--  * which code or interface file declarations are emitted+--+-- We also considered placing flags which affect asympototic space behavior+-- (e.g. -ffull-laziness) however this would mean that changing optimisation+-- levels would trigger recompilation even with -fignore-optim-changes,+-- regressing #13604.+--+-- Also, arguably Opt_IgnoreAsserts should be here as well; however, we place+-- it instead in 'optimisationFlags' since it is implied by @-O[12]@ and+-- therefore would also break #13604.+--+-- See #23369.+codeGenFlags :: EnumSet GeneralFlag+codeGenFlags = EnumSet.fromList+   [ -- Flags that affect runtime result+     Opt_EagerBlackHoling+   , Opt_ExcessPrecision+   , Opt_DictsStrict+   , Opt_PedanticBottoms+   , Opt_OmitYields++     -- Flags that affect generated code+   , Opt_ExposeAllUnfoldings+   , Opt_NoTypeableBinds++     -- Flags that affect catching of runtime errors    , Opt_CatchNonexhaustiveCases-   , Opt_IgnoreAsserts+   , Opt_LlvmFillUndefWithGarbage+   , Opt_DoTagInferenceChecks++     -- Flags that affect debugging information+   , Opt_DistinctConstructorTables+   , Opt_InfoTableMap+   , Opt_InfoTableMapWithStack+   , Opt_InfoTableMapWithFallback    ]  data WarningFlag =

@@ -61,6 +61,7 @@         makeDynFlagsConsistent,         positionIndependent,         optimisationFlags,+        codeGenFlags,         setFlagsFromEnvFile,         pprDynFlagsDiff,         flagSpecOf,@@ -2606,6 +2607,8 @@         (NoArg (setGeneralFlag Opt_DoTagInferenceChecks))   , make_ord_flag defGhcFlag "dshow-passes"         (NoArg $ forceRecompile >> (setVerbosity $ Just 2))+  , make_ord_flag defGhcFlag "dipe-stats"+        (setDumpFlag Opt_D_ipe_stats)   , make_ord_flag defGhcFlag "dfaststring-stats"         (setDumpFlag Opt_D_faststring_stats)   , make_ord_flag defGhcFlag "dno-llvm-mangler"@@ -2881,10 +2884,6 @@         -- Caller-CC   , make_ord_flag defGhcFlag "fprof-callers"          (HasArg setCallerCcFilters)-  , make_ord_flag defGhcFlag "fdistinct-constructor-tables"-      (NoArg (setGeneralFlag Opt_DistinctConstructorTables))-  , make_ord_flag defGhcFlag "finfo-table-map"-      (NoArg (setGeneralFlag Opt_InfoTableMap))         ------ Compiler flags -----------------------------------------------    , make_ord_flag defGhcFlag "fasm"             (NoArg (setObjBackend ncgBackend))@@ -3476,6 +3475,7 @@   flagSpec "specialize-aggressively"          Opt_SpecialiseAggressively,   flagSpec "cross-module-specialise"          Opt_CrossModuleSpecialise,   flagSpec "cross-module-specialize"          Opt_CrossModuleSpecialise,+  flagSpec "polymorphic-specialisation"       Opt_PolymorphicSpecialisation,   flagSpec "inline-generics"                  Opt_InlineGenerics,   flagSpec "inline-generics-aggressively"     Opt_InlineGenericsAggressively,   flagSpec "static-argument-transformation"   Opt_StaticArgumentTransformation,@@ -3512,7 +3512,11 @@         return dflags)),   flagSpec "show-error-context"               Opt_ShowErrorContext,   flagSpec "cmm-thread-sanitizer"             Opt_CmmThreadSanitizer,-  flagSpec "split-sections"                   Opt_SplitSections+  flagSpec "split-sections"                   Opt_SplitSections,+  flagSpec "distinct-constructor-tables"      Opt_DistinctConstructorTables,+  flagSpec "info-table-map"                   Opt_InfoTableMap,+  flagSpec "info-table-map-with-stack"        Opt_InfoTableMapWithStack,+  flagSpec "info-table-map-with-fallback"     Opt_InfoTableMapWithFallback   ]   ++ fHoleFlags @@ -3882,6 +3886,8 @@                 ,(Opt_Strictness, turnOn, Opt_WorkerWrapper)                 ,(Opt_WriteIfSimplifiedCore, turnOn, Opt_WriteInterface)                 ,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteIfSimplifiedCore)+                ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithStack)+                ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithFallback)                 ] ++ validHoleFitsImpliedGFlags  -- General flags that are switched on/off when other general flags are switched

@@ -209,7 +209,7 @@              -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]              -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p))) mkMatchGroup origin matches = MG { mg_ext = origin-                                 , mg_alts = matches }+                                 , mg_alts = matches }  mkLamCaseMatchGroup :: AnnoBody p body                     => Origin

@@ -175,7 +175,7 @@   | RTSRep              -- The RTS needs to declare info tables with specific         Int             -- type tags, so this form lets us override the default         SMRep           -- tag for an SMRep.-  deriving Eq+  deriving (Eq, Ord)  -- | True \<=> This is a static closure.  Affects how we garbage-collect it. -- Static closure have an extra static link field at the end.@@ -193,7 +193,7 @@   | ThunkSelector SelectorOffset   | BlackHole   | IndStatic-  deriving Eq+  deriving (Eq, Ord)  type ConstrDescription = ByteString -- result of dataConIdentity type FunArity          = Int@@ -223,7 +223,7 @@   | ArgUnknown          -- For imported binds.                         -- Invariant: Never Unknown for binds of the module                         -- we are compiling.-  deriving (Eq)+  deriving (Eq, Ord)  instance Outputable ArgDescr where   ppr (ArgSpec n) = text "ArgSpec" <+> ppr n

@@ -236,7 +236,7 @@         -- which can't be let-bound   | StgConApp   DataCon                 ConstructorNumber-                [StgArg] -- Saturated+                [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg])                 [Type]   -- See Note [Types in StgConApp] in GHC.Stg.Unarise    | StgOpApp    StgOp    -- Primitive op or foreign call

@@ -49,8 +49,9 @@   , stgToCmmFastPAPCalls   :: !Bool              -- ^   , stgToCmmSCCProfiling   :: !Bool              -- ^ Check if cost-centre profiling is enabled   , stgToCmmEagerBlackHole :: !Bool              -- ^-  , stgToCmmInfoTableMap   :: !Bool              -- ^ true means generate C Stub for IPE map, See note [Mapping-                                                 -- Info Tables to Source Positions]+  , stgToCmmInfoTableMap   :: !Bool              -- ^ true means generate C Stub for IPE map, See Note [Mapping Info Tables to Source Positions]+  , stgToCmmInfoTableMapWithFallback :: !Bool    -- ^ Include info tables with fallback source locations in the info table map+  , stgToCmmInfoTableMapWithStack :: !Bool       -- ^ Include info tables for STACK closures in the info table map   , stgToCmmOmitYields     :: !Bool              -- ^ true means omit heap checks when no allocation is performed   , stgToCmmOmitIfPragmas  :: !Bool              -- ^ true means don't generate interface programs (implied by -O0)   , stgToCmmPIC            :: !Bool              -- ^ true if @-fPIC@

@@ -70,6 +70,52 @@ * We don't absolutely guarantee to serialise the CgInfo: we won't if you have   -fomit-interface-pragmas or -fno-code; and we won't read it in if you have   -fignore-interface-pragmas.  (We could revisit this decision.)++Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+As described in `Note [Conveying CAF-info and LFInfo between modules]`,+imported unlifted nullary datacons must have their LambdaFormInfo set to+reflect the fact that they are evaluated . This is necessary as otherwise+references to them may be passed untagged to code that expects tagged+references.++What may be less obvious is that this must be done for not only datacon+workers but also *wrappers*. The reason is found in this program+from #23146:++    module B where++    type NP :: [UnliftedType] -> UnliftedType+    data NP xs where+      UNil :: NP '[]+++    module A where+    import B++    fieldsSam :: NP xs -> NP xs -> Bool+    fieldsSam UNil UNil = True++    x = fieldsSam UNil UNil++Due to its GADT nature, `B.UNil` produces a trivial wrapper++    $WUNil :: NP '[]+    $WUNil = UNil @'[] @~(<co:1>)++which is referenced in the RHS of `A.x`. If we fail to give `$WUNil` the+correct `LFCon 0` `LambdaFormInfo` then we will end up passing an untagged+pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage+of the unlifted nature of its arguments by omitting handling of the zero+tag when scrutinising them.++The fix is straightforward: extend the logic in `mkLFImported` to cover+(nullary) datacon wrappers as well as workers. This is safe because we+know that the wrapper of a nullary datacon will be in WHNF, even if it+includes equalities evidence (since such equalities are not runtime+relevant). This fixed #23146.++See also Note [The LFInfo of Imported Ids] -}  -- | Codegen-generated Id infos, to be passed to downstream via interfaces.@@ -118,7 +164,7 @@         !StandardFormInfo         !Bool           -- True <=> *might* be a function type -  | LFCon               -- A saturated constructor application+  | LFCon               -- A saturated data constructor application         !DataCon        -- The constructor    | LFUnknown           -- Used for function arguments and imported things.

@@ -1238,6 +1238,11 @@           = vcat [ text "Starting from GHC 9.10, this warning will turn into an error." ]         user_manual =           vcat [ text "See the user manual, § Undecidable instances and loopy superclasses." ]+    TcRnCannotDefaultConcrete frr+      -> mkSimpleDecorated $+         ppr (frr_context frr) $$+         text "cannot be assigned a fixed runtime representation," <+>+         text "not even by defaulting."    diagnosticReason = \case     TcRnUnknownMessage m@@ -1646,6 +1651,8 @@       -> ErrorWithoutFlag     TcRnLoopySuperclassSolve{}       -> WarningWithFlag Opt_WarnLoopySuperclassSolve+    TcRnCannotDefaultConcrete{}+      -> ErrorWithoutFlag    diagnosticHints = \case     TcRnUnknownMessage m@@ -2064,6 +2071,8 @@         cls_or_qc = case ctLocOrigin wtd_loc of           ScOrigin c_or_q _ -> c_or_q           _                 -> IsClsInst -- shouldn't happen+    TcRnCannotDefaultConcrete{}+      -> [SuggestAddTypeSignatures UnnamedBinding]    diagnosticCode = constructorCode 

@@ -2793,6 +2793,17 @@                            -> PredType -- ^ Wanted 'PredType'                            -> TcRnMessage +  {- TcRnCannotDefaultConcrete is an error occurring when a concrete+    type variable cannot be defaulted.++    Test cases:+      T23153+  -}+  TcRnCannotDefaultConcrete+    :: !FixedRuntimeRepOrigin+    -> TcRnMessage++   deriving Generic  -- | Things forbidden in @type data@ declarations.@@ -3322,7 +3333,9 @@   = EI { ei_pred     :: PredType         -- report about this          -- The ei_pred field will never be an unboxed equality with          -- a (casted) tyvar on the right; this is guaranteed by the solver-       , ei_evdest   :: Maybe TcEvDest   -- for Wanteds, where to put evidence+       , ei_evdest   :: Maybe TcEvDest+         -- ^ for Wanteds, where to put the evidence+         --   for Givens, Nothing        , ei_flavour  :: CtFlavour        , ei_loc      :: CtLoc        , ei_m_reason :: Maybe CtIrredReason  -- if this ErrorItem was made from a

@@ -1774,7 +1774,12 @@           <+> ppr (deProposalCts p)  type DefaultingPluginResult = [DefaultingProposal]-type FillDefaulting = WantedConstraints -> TcPluginM DefaultingPluginResult+type FillDefaulting+  = WantedConstraints+      -- Zonked constraints containing the unfilled metavariables that+      -- can be defaulted. See wrinkle (DP1) of Note [Defaulting plugins]+      -- in GHC.Tc.Solver+  -> TcPluginM [DefaultingProposal]  -- | A plugin for controlling defaulting. data DefaultingPlugin = forall s. DefaultingPlugin

@@ -1338,6 +1338,7 @@       -- NB: including stuff used by nested implications that have since       --     been discarded       -- See Note [Needed evidence variables]+      -- and (RC2) in Note [Tracking redundant constraints]a       ic_need_inner :: VarSet,    -- Includes all used Given evidence       ic_need_outer :: VarSet,    -- Includes only the free Given evidence                                   --  i.e. ic_need_inner after deleting@@ -2127,10 +2128,10 @@ holes. The idea is that we wish to report the "root cause" -- the error that rewrote all the others. -Worry: It seems possible that *all* unsolved wanteds are rewritten by other-unsolved wanteds, so that e.g. w1 has w2 in its rewriter set, and w2 has-w1 in its rewiter set. We are unable to come up with an example of this in-practice, however, and so we believe this case cannot happen.+Wrinkle: In #22707, we have a case where all of the Wanteds have rewritten+each other. In order to report /some/ error in this case, we simply report+all the Wanteds. The user will get a perhaps-confusing error message, but+they've written a confusing program!  Note [Avoiding rewriting cycles] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -43,23 +43,20 @@     -- ** Manipulating Boxity of a Demand     unboxDeeplyDmd, -    -- * Demand environments-    DmdEnv, emptyDmdEnv,-    keepAliveDmdEnv, reuseEnv,-     -- * Divergence     Divergence(..), topDiv, botDiv, exnDiv, lubDivergence, isDeadEndDiv, +    -- * Demand environments+    DmdEnv(..), addVarDmdEnv, mkTermDmdEnv, nopDmdEnv, plusDmdEnv, plusDmdEnvs,+    reuseEnv,+     -- * Demand types     DmdType(..), dmdTypeDepth,     -- ** Algebra     nopDmdType, botDmdType,-    lubDmdType, plusDmdType, multDmdType,-    -- *** PlusDmdArg-    PlusDmdArg, mkPlusDmdArg, toPlusDmdArg,+    lubDmdType, plusDmdType, multDmdType, discardArgDmds,     -- ** Other operations     peelFV, findIdDemand, addDemand, splitDmdTy, deferAfterPreciseException,-    keepAliveDmdType,      -- * Demand signatures     DmdSig(..), mkDmdSigForArity, mkClosedDmdSig, mkVanillaDmdSig,@@ -85,9 +82,8 @@  import GHC.Prelude -import GHC.Types.Var ( Var, Id )+import GHC.Types.Var import GHC.Types.Var.Env-import GHC.Types.Var.Set import GHC.Types.Unique.FM import GHC.Types.Basic import GHC.Data.Maybe   ( orElse )@@ -1054,7 +1050,7 @@  argsOneShots :: DmdSig -> Arity -> [[OneShotInfo]] -- ^ See Note [Computing one-shot info]-argsOneShots (DmdSig (DmdType _ arg_ds _)) n_val_args+argsOneShots (DmdSig (DmdType _ arg_ds)) n_val_args   | unsaturated_call = []   | otherwise = go arg_ds   where@@ -1466,7 +1462,7 @@ -- defaultFvDmd (r1 `lubDivergence` r2) = defaultFvDmd r1 `lubDmd` defaultFvDmd r2 -- (See Note [Default demand on free variables and arguments] for why) --- | See Note [Asymmetry of 'plus*'], which concludes that 'plusDivergence'+-- | See Note [Asymmetry of plusDmdType], which concludes that 'plusDivergence' -- needs to be symmetric. -- Strictly speaking, we should have @plusDivergence Dunno Diverges = ExnOrDiv@. -- But that regresses in too many places (every infinite loop, basically) to be@@ -1737,112 +1733,131 @@ -}  -- Subject to Note [Default demand on free variables and arguments]-type DmdEnv = VarEnv Demand+-- | Captures the result of an evaluation of an expression, by+--+--   * Listing how the free variables of that expression have been evaluted+--     ('de_fvs')+--   * Saying whether or not evaluation would surely diverge ('de_div')+--+-- See Note [Demand env Equality].+data DmdEnv = DE { de_fvs :: !(VarEnv Demand), de_div :: !Divergence } -emptyDmdEnv :: DmdEnv-emptyDmdEnv = emptyVarEnv+instance Eq DmdEnv where+  DE fv1 div1 == DE fv2 div2+    = div1 == div2 && canonicalise div1 fv1 == canonicalise div2 fv2+    where+      canonicalise div fv = filterUFM (/= defaultFvDmd div) fv +mkEmptyDmdEnv :: Divergence -> DmdEnv+mkEmptyDmdEnv div = DE emptyVarEnv div++-- | Build a potentially terminating 'DmdEnv' from a finite map that says what+-- has been evaluated so far+mkTermDmdEnv :: VarEnv Demand -> DmdEnv+mkTermDmdEnv fvs = DE fvs topDiv++nopDmdEnv :: DmdEnv+nopDmdEnv = mkEmptyDmdEnv topDiv++botDmdEnv :: DmdEnv+botDmdEnv = mkEmptyDmdEnv botDiv++exnDmdEnv :: DmdEnv+exnDmdEnv = mkEmptyDmdEnv exnDiv++lubDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv+lubDmdEnv (DE fv1 d1) (DE fv2 d2) = DE lub_fv lub_div+  where+    -- See Note [Demand env Equality]+    lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2)+    lub_div = lubDivergence d1 d2++addVarDmdEnv :: DmdEnv -> Id -> Demand -> DmdEnv+addVarDmdEnv env@(DE fvs div) id dmd+  = DE (extendVarEnv fvs id (dmd `plusDmd` lookupDmdEnv env id)) div++plusDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv+plusDmdEnv (DE fv1 d1) (DE fv2 d2)+  -- In contrast to Note [Asymmetry of plusDmdType], this function is symmetric.+  | isEmptyVarEnv fv2, defaultFvDmd d2 == absDmd+  = DE fv1 (d1 `plusDivergence` d2) -- a very common case that is much more efficient+  | isEmptyVarEnv fv1, defaultFvDmd d1 == absDmd+  = DE fv2 (d1 `plusDivergence` d2) -- another very common case that is much more efficient+  | otherwise+  = DE (plusVarEnv_CD plusDmd fv1 (defaultFvDmd d1) fv2 (defaultFvDmd d2))+       (d1 `plusDivergence` d2)++-- | 'DmdEnv' is a monoid via 'plusDmdEnv' and 'nopDmdEnv'; this is its 'msum'+plusDmdEnvs :: [DmdEnv] -> DmdEnv+plusDmdEnvs []   = nopDmdEnv+plusDmdEnvs pdas = foldl1' plusDmdEnv pdas+ multDmdEnv :: Card -> DmdEnv -> DmdEnv-multDmdEnv C_11 env = env-multDmdEnv C_00 _   = emptyDmdEnv-multDmdEnv n    env = mapVarEnv (multDmd n) env+multDmdEnv C_11 env          = env+multDmdEnv C_00 _            = nopDmdEnv+multDmdEnv n    (DE fvs div) = DE (mapVarEnv (multDmd n) fvs) (multDivergence n div)  reuseEnv :: DmdEnv -> DmdEnv reuseEnv = multDmdEnv C_1N --- | @keepAliveDmdType dt vs@ makes sure that the Ids in @vs@ have--- /some/ usage in the returned demand types -- they are not Absent.--- See Note [Absence analysis for stable unfoldings and RULES]---     in "GHC.Core.Opt.DmdAnal".-keepAliveDmdEnv :: DmdEnv -> IdSet -> DmdEnv-keepAliveDmdEnv env vs-  = nonDetStrictFoldVarSet add env vs-  where-    add :: Id -> DmdEnv -> DmdEnv-    add v env = extendVarEnv_C add_dmd env v topDmd+lookupDmdEnv :: DmdEnv -> Id -> Demand+-- See Note [Default demand on free variables and arguments]+lookupDmdEnv (DE fv div) id = lookupVarEnv fv id `orElse` defaultFvDmd div -    add_dmd :: Demand -> Demand -> Demand-    -- If the existing usage is Absent, make it used-    -- Otherwise leave it alone-    add_dmd dmd _ | isAbsDmd dmd = topDmd-                  | otherwise    = dmd+delDmdEnv :: DmdEnv -> Id -> DmdEnv+delDmdEnv (DE fv div) id = DE (fv `delVarEnv` id) div  -- | Characterises how an expression -----    * Evaluates its free variables ('dt_env')+--    * Evaluates its free variables ('dt_env') including divergence info --    * Evaluates its arguments ('dt_args')---    * Diverges on every code path or not ('dt_div') ----- Equality is defined modulo 'defaultFvDmd's in 'dt_env'.--- See Note [Demand type Equality]. data DmdType   = DmdType-  { dt_env  :: !DmdEnv     -- ^ Demand on explicitly-mentioned free variables+  { dt_env  :: !DmdEnv     -- ^ Demands on free variables.+                           -- See Note [Demand type Divergence]   , dt_args :: ![Demand]   -- ^ Demand on arguments-  , dt_div  :: !Divergence -- ^ Whether evaluation diverges.-                          -- See Note [Demand type Divergence]   } --- | See Note [Demand type Equality].+-- | See Note [Demand env Equality]. instance Eq DmdType where-  (==) (DmdType fv1 ds1 div1)-       (DmdType fv2 ds2 div2) =  div1 == div2 && ds1 == ds2 -- cheap checks first-                              && canonicalise div1 fv1 == canonicalise div2 fv2-       where-         canonicalise div fv = filterUFM (/= defaultFvDmd div) fv+  DmdType env1 ds1 == DmdType env2 ds2+    = ds1 == ds2 -- cheap checks first+      && env1 == env2  -- | Compute the least upper bound of two 'DmdType's elicited /by the same -- incoming demand/! lubDmdType :: DmdType -> DmdType -> DmdType-lubDmdType d1 d2-  = DmdType lub_fv lub_ds lub_div+lubDmdType d1 d2 = DmdType lub_fv lub_ds   where     n = max (dmdTypeDepth d1) (dmdTypeDepth d2)-    (DmdType fv1 ds1 r1) = etaExpandDmdType n d1-    (DmdType fv2 ds2 r2) = etaExpandDmdType n d2--    -- See Note [Demand type Equality]-    lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultFvDmd r1) fv2 (defaultFvDmd r2)+    (DmdType fv1 ds1) = etaExpandDmdType n d1+    (DmdType fv2 ds2) = etaExpandDmdType n d2     lub_ds  = zipWithEqual "lubDmdType" lubDmd ds1 ds2-    lub_div = lubDivergence r1 r2--type PlusDmdArg = (DmdEnv, Divergence)--mkPlusDmdArg :: DmdEnv -> PlusDmdArg-mkPlusDmdArg env = (env, topDiv)+    lub_fv = lubDmdEnv fv1 fv2 -toPlusDmdArg :: DmdType -> PlusDmdArg-toPlusDmdArg (DmdType fv _ r) = (fv, r)+discardArgDmds :: DmdType -> DmdEnv+discardArgDmds (DmdType fv _) = fv -plusDmdType :: DmdType -> PlusDmdArg -> DmdType-plusDmdType (DmdType fv1 ds1 r1) (fv2, t2)-    -- See Note [Asymmetry of 'plus*']-    -- 'plus' takes the argument/result info from its *first* arg,-    -- using its second arg just for its free-var info.-  | isEmptyVarEnv fv2, defaultFvDmd t2 == absDmd-  = DmdType fv1 ds1 (r1 `plusDivergence` t2) -- a very common case that is much more efficient-  | otherwise-  = DmdType (plusVarEnv_CD plusDmd fv1 (defaultFvDmd r1) fv2 (defaultFvDmd t2))-            ds1-            (r1 `plusDivergence` t2)+plusDmdType :: DmdType -> DmdEnv -> DmdType+plusDmdType (DmdType fv ds) fv'+  -- See Note [Asymmetry of plusDmdType]+  -- 'DmdEnv' forms a (monoidal) action on 'DmdType' via this operation.+  = DmdType (plusDmdEnv fv fv') ds  botDmdType :: DmdType-botDmdType = DmdType emptyDmdEnv [] botDiv+botDmdType = DmdType botDmdEnv []  -- | The demand type of doing nothing (lazy, absent, no Divergence -- information). Note that it is ''not'' the top of the lattice (which would be -- "may use everything"), so it is (no longer) called topDmdType. nopDmdType :: DmdType-nopDmdType = DmdType emptyDmdEnv [] topDiv--isNopDmdType :: DmdType -> Bool-isNopDmdType (DmdType env args div)-  = div == topDiv && null args && isEmptyVarEnv env+nopDmdType = DmdType nopDmdEnv []  -- | The demand type of an unspecified expression that is guaranteed to -- throw a (precise or imprecise) exception or diverge. exnDmdType :: DmdType-exnDmdType = DmdType emptyDmdEnv [] exnDiv+exnDmdType = DmdType exnDmdEnv []  dmdTypeDepth :: DmdType -> Arity dmdTypeDepth = length . dt_args@@ -1851,7 +1866,7 @@ -- expansion, where n must not be lower than the demand types depth. -- It appends the argument list with the correct 'defaultArgDmd'. etaExpandDmdType :: Arity -> DmdType -> DmdType-etaExpandDmdType n d@DmdType{dt_args = ds, dt_div = div}+etaExpandDmdType n d@DmdType{dt_args = ds, dt_env = env}   | n == depth = d   | n >  depth = d{dt_args = inc_ds}   | otherwise  = pprPanic "etaExpandDmdType: arity decrease" (ppr n $$ ppr d)@@ -1863,7 +1878,7 @@         --  * Divergence is still valid:         --    - A dead end after 2 arguments stays a dead end after 3 arguments         --    - The remaining case is Dunno, which is already topDiv-        inc_ds = take n (ds ++ repeat (defaultArgDmd div))+        inc_ds = take n (ds ++ repeat (defaultArgDmd (de_div env)))  -- | A conservative approximation for a given 'DmdType' in case of an arity -- decrease. Currently, it's just nopDmdType.@@ -1875,30 +1890,27 @@ -- We already have a suitable demand on all -- free vars, so no need to add more! splitDmdTy ty@DmdType{dt_args=dmd:args} = (dmd, ty{dt_args=args})-splitDmdTy ty@DmdType{dt_div=div}       = (defaultArgDmd div, ty)+splitDmdTy ty@DmdType{dt_env=env}       = (defaultArgDmd (de_div env), ty)  multDmdType :: Card -> DmdType -> DmdType-multDmdType n (DmdType fv args res_ty)+multDmdType n (DmdType fv args)   = -- pprTrace "multDmdType" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $     DmdType (multDmdEnv n fv)             (map (multDmd n) args)-            (multDivergence n res_ty)  peelFV :: DmdType -> Var -> (DmdType, Demand)-peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)-                               (DmdType fv' ds res, dmd)+peelFV (DmdType fv ds) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)+                            (DmdType fv' ds, dmd)   where   -- Force these arguments so that old `Env` is not retained.-  !fv' = fv `delVarEnv` id-  -- See Note [Default demand on free variables and arguments]-  !dmd  = lookupVarEnv fv id `orElse` defaultFvDmd res+  !fv' = fv `delDmdEnv` id+  !dmd = lookupDmdEnv fv id  addDemand :: Demand -> DmdType -> DmdType-addDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res+addDemand dmd (DmdType fv ds) = DmdType fv (dmd:ds)  findIdDemand :: DmdType -> Var -> Demand-findIdDemand (DmdType fv _ res) id-  = lookupVarEnv fv id `orElse` defaultFvDmd res+findIdDemand (DmdType fv _) id = lookupDmdEnv fv id  -- | When e is evaluated after executing an IO action that may throw a precise -- exception, we act as if there is an additional control flow path that is@@ -1914,11 +1926,6 @@ deferAfterPreciseException :: DmdType -> DmdType deferAfterPreciseException = lubDmdType exnDmdType --- | See 'keepAliveDmdEnv'.-keepAliveDmdType :: DmdType -> VarSet -> DmdType-keepAliveDmdType (DmdType fvs ds res) vars =-  DmdType (fvs `keepAliveDmdEnv` vars) ds res- {- Note [deferAfterPreciseException] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The big picture is in Note [Precise exceptions and strictness analysis]@@ -1974,32 +1981,25 @@ strong enough to unleash err's signature and hence we see that the whole expression diverges! -Note [Demand type Equality]+Note [Demand env Equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~-What is the difference between the DmdType <L>{x->A} and <L>?+What is the difference between the Demand env {x->A} and {}? Answer: There is none! They have the exact same semantics, because any var that-is not mentioned in 'dt_env' implicitly has demand 'defaultFvDmd', based on-the divergence of the demand type 'dt_div'.-Similarly, <B>b{x->B, y->A} is the same as <B>b{y->A}, because the default FV-demand of BotDiv is B. But neither is equal to <B>b, because y has demand B in+is not mentioned in 'de_fvs' implicitly has demand 'defaultFvDmd', based on+the divergence of the demand env 'de_div'.+Similarly, b{x->B, y->A} is the same as b{y->A}, because the default FV+demand of BotDiv is B. But neither is equal to b{}, because y has demand B in the latter, not A as before. -NB: 'dt_env' technically can't stand for its own, because it doesn't tell us the-demand on FVs that don't appear in the DmdEnv. Hence 'PlusDmdArg' carries along-a 'Divergence', for example.--The Eq instance of DmdType must reflect that, otherwise we can get into monotonicity-issues during fixed-point iteration (<L>{x->A} /= <L> /= <L>{x->A} /= ...).-It does so by filtering out any default FV demands prior to comparing 'dt_env'.-An alternative would be to maintain an invariant that there are no default FV demands-in 'dt_env' to begin with, but that seems more involved to maintain in the current-implementation.+The Eq instance of DmdEnv must reflect that, otherwise we can get into monotonicity+issues during fixed-point iteration ({x->A} /= {} /= {x->A} /= ...).+It does so by filtering out any default FV demands prior to comparing 'de_fvs'. -Note that 'lubDmdType' maintains this kind of equality by using 'plusVarEnv_CD',-involving 'defaultFvDmd' for any entries present in one 'dt_env' but not the+Note that 'lubDmdEnv' maintains this kind of equality by using 'plusVarEnv_CD',+involving 'defaultFvDmd' for any entries present in one 'de_fvs' but not the other. -Note [Asymmetry of 'plus*']+Note [Asymmetry of plusDmdType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 'plus' for DmdTypes is *asymmetrical*, because there can only one be one type contributing argument demands!  For example, given (e1 e2), we get@@ -2155,24 +2155,24 @@ -- | Turns a 'DmdType' computed for the particular 'Arity' into a 'DmdSig' -- unleashable at that arity. See Note [Understanding DmdType and DmdSig]. mkDmdSigForArity :: Arity -> DmdType -> DmdSig-mkDmdSigForArity arity dmd_ty@(DmdType fvs args div)-  | arity < dmdTypeDepth dmd_ty = DmdSig $ DmdType fvs (take arity args) div+mkDmdSigForArity arity dmd_ty@(DmdType fvs args)+  | arity < dmdTypeDepth dmd_ty = DmdSig $ DmdType fvs (take arity args)   | otherwise                   = DmdSig (etaExpandDmdType arity dmd_ty)  mkClosedDmdSig :: [Demand] -> Divergence -> DmdSig-mkClosedDmdSig ds res = mkDmdSigForArity (length ds) (DmdType emptyDmdEnv ds res)+mkClosedDmdSig ds div = mkDmdSigForArity (length ds) (DmdType (mkEmptyDmdEnv div) ds)  mkVanillaDmdSig :: Arity -> Divergence -> DmdSig mkVanillaDmdSig ar div = mkClosedDmdSig (replicate ar topDmd) div  splitDmdSig :: DmdSig -> ([Demand], Divergence)-splitDmdSig (DmdSig (DmdType _ dmds res)) = (dmds, res)+splitDmdSig (DmdSig (DmdType env dmds)) = (dmds, de_div env)  dmdSigDmdEnv :: DmdSig -> DmdEnv-dmdSigDmdEnv (DmdSig (DmdType env _ _)) = env+dmdSigDmdEnv (DmdSig (DmdType env _)) = env  hasDemandEnvSig :: DmdSig -> Bool-hasDemandEnvSig = not . isEmptyVarEnv . dmdSigDmdEnv+hasDemandEnvSig = not . isEmptyVarEnv . de_fvs . dmdSigDmdEnv  botSig :: DmdSig botSig = DmdSig botDmdType@@ -2181,23 +2181,23 @@ nopSig = DmdSig nopDmdType  isNopSig :: DmdSig -> Bool-isNopSig (DmdSig ty) = isNopDmdType ty+isNopSig (DmdSig ty) = ty == nopDmdType  -- | True if the signature diverges or throws an exception in a saturated call. -- See Note [Dead ends]. isDeadEndSig :: DmdSig -> Bool-isDeadEndSig (DmdSig (DmdType _ _ res)) = isDeadEndDiv res+isDeadEndSig (DmdSig (DmdType env _)) = isDeadEndDiv (de_div env)  -- | True if the signature diverges or throws an imprecise exception in a saturated call. -- NB: In constrast to 'isDeadEndSig' this returns False for 'exnDiv'. -- See Note [Dead ends] -- and Note [Precise vs imprecise exceptions]. isBottomingSig :: DmdSig -> Bool-isBottomingSig (DmdSig (DmdType _ _ res)) = res == botDiv+isBottomingSig (DmdSig (DmdType env _)) = de_div env == botDiv  -- | True when the signature indicates all arguments are boxed onlyBoxedArguments :: DmdSig -> Bool-onlyBoxedArguments (DmdSig (DmdType _ dmds _)) = all demandIsBoxed dmds+onlyBoxedArguments (DmdSig (DmdType _ dmds)) = all demandIsBoxed dmds  where    demandIsBoxed BotDmd    = True    demandIsBoxed AbsDmd    = True@@ -2217,12 +2217,15 @@ -- Hence this function conservatively returns False in that case. -- See Note [Dead ends]. isDeadEndAppSig :: DmdSig -> Int -> Bool-isDeadEndAppSig (DmdSig (DmdType _ ds res)) n-  = isDeadEndDiv res && not (lengthExceeds ds n)+isDeadEndAppSig (DmdSig (DmdType env ds)) n+  = isDeadEndDiv (de_div env) && not (lengthExceeds ds n) +trimBoxityDmdEnv :: DmdEnv -> DmdEnv+trimBoxityDmdEnv (DE fvs div) = DE (mapVarEnv trimBoxity fvs) div+ trimBoxityDmdType :: DmdType -> DmdType-trimBoxityDmdType (DmdType fvs ds res) =-  DmdType (mapVarEnv trimBoxity fvs) (map trimBoxity ds) res+trimBoxityDmdType (DmdType env ds) =+  DmdType (trimBoxityDmdEnv env) (map trimBoxity ds)  trimBoxityDmdSig :: DmdSig -> DmdSig trimBoxityDmdSig = coerce trimBoxityDmdType@@ -2247,12 +2250,11 @@           _ -> trimBoxity to_dmd  transferArgBoxityDmdType :: DmdType -> DmdType -> DmdType-transferArgBoxityDmdType _from@(DmdType _ from_ds _) to@(DmdType to_fvs to_ds to_res)+transferArgBoxityDmdType _from@(DmdType _ from_ds) to@(DmdType to_env to_ds)   | equalLength from_ds to_ds   = -- pprTraceWith "transfer" (\r -> ppr _from $$ ppr to $$ ppr r) $-    DmdType to_fvs -- Only arg boxity! See Note [Don't change boxity without worker/wrapper]+    DmdType to_env -- Only arg boxity! See Note [Don't change boxity without worker/wrapper]             (zipWith transferBoxity from_ds to_ds)-            to_res   | otherwise   = trimBoxityDmdType to @@ -2263,10 +2265,10 @@ -- ^ Add extra ('topDmd') arguments to a strictness signature. -- In contrast to 'etaConvertDmdSig', this /prepends/ additional argument -- demands. This is used by FloatOut.-prependArgsDmdSig new_args sig@(DmdSig dmd_ty@(DmdType env dmds res))-  | new_args == 0       = sig-  | isNopDmdType dmd_ty = sig-  | otherwise           = DmdSig (DmdType env dmds' res)+prependArgsDmdSig new_args sig@(DmdSig dmd_ty@(DmdType env dmds))+  | new_args == 0        = sig+  | dmd_ty == nopDmdType = sig+  | otherwise            = DmdSig (DmdType env dmds')   where     dmds' = assertPpr (new_args > 0) (ppr new_args) $             replicate new_args topDmd ++ dmds@@ -2308,7 +2310,7 @@ -- Given a function's 'DmdSig' and a 'SubDemand' for the evaluation context, -- return how the function evaluates its free variables and arguments. dmdTransformSig :: DmdSig -> DmdTransformer-dmdTransformSig (DmdSig dmd_ty@(DmdType _ arg_ds _)) sd+dmdTransformSig (DmdSig dmd_ty@(DmdType _ arg_ds)) sd   = multDmdType (fst $ peelManyCalls (length arg_ds) sd) dmd_ty     -- see Note [Demands from unsaturated function calls]     -- and Note [What are demand signatures?]@@ -2323,7 +2325,7 @@   where     arity = length str_marks     (n, body_sd) = peelManyCalls arity sd-    mk_body_ty n dmds = DmdType emptyDmdEnv (zipWith (bump n) str_marks dmds) topDiv+    mk_body_ty n dmds = DmdType nopDmdEnv (zipWith (bump n) str_marks dmds)     bump n str dmd | isMarkedStrict str = multDmd n (plusDmd str_field_dmd dmd)                    | otherwise          = multDmd n dmd     str_field_dmd = C_01 :* seqSubDmd -- Why not C_11? See Note [Data-con worker strictness]@@ -2334,11 +2336,11 @@ dmdTransformDictSelSig :: DmdSig -> DmdTransformer -- NB: This currently doesn't handle newtype dictionaries. -- It should simply apply call_sd directly to the dictionary, I suppose.-dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod] _)) call_sd+dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod])) call_sd    | (n, sd') <- peelCallDmd call_sd    , Prod _ sig_ds <- prod    = multDmdType n $-     DmdType emptyDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)] topDiv+     DmdType nopDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)]    | otherwise    = nopDmdType -- See Note [Demand transformer for a dictionary selector]   where@@ -2460,9 +2462,12 @@ it should not fall over. -} +zapDmdEnv :: DmdEnv -> DmdEnv+zapDmdEnv (DE _ div) = mkEmptyDmdEnv div+ -- | Remove the demand environment from the signature. zapDmdEnvSig :: DmdSig -> DmdSig-zapDmdEnvSig (DmdSig (DmdType _ ds r)) = mkClosedDmdSig ds r+zapDmdEnvSig (DmdSig (DmdType env ds)) = DmdSig (DmdType (zapDmdEnv env) ds)  zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand@@ -2483,8 +2488,8 @@ -- | Remove all `C_01 :*` info (but not `CM` sub-demands) from the strictness --   signature zapUsedOnceSig :: DmdSig -> DmdSig-zapUsedOnceSig (DmdSig (DmdType env ds r))-    = DmdSig (DmdType env (map zapUsedOnceDemand ds) r)+zapUsedOnceSig (DmdSig (DmdType env ds))+    = DmdSig (DmdType env (map zapUsedOnceDemand ds))  data KillFlags = KillFlags     { kf_abs         :: Bool@@ -2569,11 +2574,11 @@ seqDemandList = foldr (seq . seqDemand) ()  seqDmdType :: DmdType -> ()-seqDmdType (DmdType env ds res) =-  seqDmdEnv env `seq` seqDemandList ds `seq` res `seq` ()+seqDmdType (DmdType env ds) =+  seqDmdEnv env `seq` seqDemandList ds `seq` ()  seqDmdEnv :: DmdEnv -> ()-seqDmdEnv env = seqEltsUFM seqDemand env+seqDmdEnv (DE fvs _) = seqEltsUFM seqDemand fvs  seqDmdSig :: DmdSig -> () seqDmdSig (DmdSig ty) = seqDmdType ty@@ -2682,17 +2687,20 @@   ppr ExnOrDiv = char 'x' -- for e(x)ception   ppr Dunno    = empty -instance Outputable DmdType where-  ppr (DmdType fv ds res)-    = hsep [hcat (map (angleBrackets . ppr) ds) <> ppr res,-            if null fv_elts then empty-            else braces (fsep (map pp_elt fv_elts))]+instance Outputable DmdEnv where+  ppr (DE fvs div)+    = ppr div <> if null fv_elts then empty+                 else braces (fsep (map pp_elt fv_elts))     where       pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd-      fv_elts = nonDetUFMToList fv+      fv_elts = nonDetUFMToList fvs         -- It's OK to use nonDetUFMToList here because we only do it for         -- pretty printing +instance Outputable DmdType where+  ppr (DmdType fv ds)+    = hcat (map (angleBrackets . ppr) ds) <> ppr fv+ instance Outputable DmdSig where    ppr (DmdSig ty) = ppr ty @@ -2741,15 +2749,6 @@       2 -> Prod <$> get bh <*> get bh       _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int)) -instance Binary DmdSig where-  put_ bh (DmdSig aa) = put_ bh aa-  get bh = DmdSig <$> get bh--instance Binary DmdType where-  -- Ignore DmdEnv when spitting out the DmdType-  put_ bh (DmdType _ ds dr) = put_ bh ds *> put_ bh dr-  get bh = DmdType emptyDmdEnv <$> get bh <*> get bh- instance Binary Divergence where   put_ bh Dunno    = putByte bh 0   put_ bh ExnOrDiv = putByte bh 1@@ -2761,3 +2760,16 @@       1 -> return ExnOrDiv       2 -> return Diverges       _ -> pprPanic "Binary:Divergence" (ppr (fromIntegral h :: Int))++instance Binary DmdEnv where+  -- Ignore VarEnv when spitting out the DmdType+  put_ bh (DE _ d) = put_ bh d+  get bh = DE emptyVarEnv <$> get bh++instance Binary DmdType where+  put_ bh (DmdType fv ds) = put_ bh fv *> put_ bh ds+  get bh = DmdType <$> get bh <*> get bh++instance Binary DmdSig where+  put_ bh (DmdSig aa) = put_ bh aa+  get bh = DmdSig <$> get bh

@@ -598,6 +598,8 @@   GhcDiagnosticCode "EmptyStmtsGroupInDoNotation"                   = 82311   GhcDiagnosticCode "EmptyStmtsGroupInArrowNotation"                = 19442 +  GhcDiagnosticCode "TcRnCannotDefaultConcrete"                     = 52083+   -- To generate new random numbers:   --  https://www.random.org/integers/?num=10&min=1&max=99999&col=1&base=10&format=plain   --

@@ -697,6 +697,8 @@ setIdCallArity :: Id -> Arity -> Id setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id +-- | This function counts all arguments post-unarisation, which includes+-- arguments with no runtime representation -- see Note [Unarisation and arity] idFunRepArity :: Id -> RepArity idFunRepArity x = countFunRepArgs (idArity x) (idType x) 

@@ -369,6 +369,7 @@         --         -- See documentation of the getters for what these packed fields mean.         lfInfo          :: !(Maybe LambdaFormInfo),+        -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure          -- See documentation of the getters for what these packed fields mean.         tagSig          :: !(Maybe TagSig)@@ -434,7 +435,7 @@ oneShotInfo = bitfieldGetOneShotInfo . bitfield  -- | 'Id' arity, as computed by "GHC.Core.Opt.Arity". Specifies how many arguments--- this 'Id' has to be applied to before it doesn any meaningful work.+-- this 'Id' has to be applied to before it does any meaningful work. arityInfo :: IdInfo -> ArityInfo arityInfo = bitfieldGetArityInfo . bitfield 

@@ -1000,8 +1000,9 @@    take apart a case scrutinisation on, or arg occurrence of, e.g.,    `RUBBISH[TupleRep[IntRep,DoubleRep]]` (which may stand in for `(# Int#, Double# #)`)    into its sub-parts `RUBBISH[IntRep]` and `RUBBISH[DoubleRep]`, similar to-   unboxed tuples. `RUBBISH[VoidRep]` is erased.-   See 'unariseRubbish_maybe' and also Note [Post-unarisation invariants].+   unboxed tuples.++   See 'unariseLiteral_maybe' and also Note [Post-unarisation invariants].  4. Cmm: We translate 'LitRubbish' to their actual rubbish value in 'cgLit'.    The particulars are boring, and only matter when debugging illicit use of

@@ -602,8 +602,10 @@   = pprPanic "kindPrimRep" (ppr ki)  -- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that--- it encodes. See also Note [Getting from RuntimeRep to PrimRep]--- The [PrimRep] is the final runtime representation /after/ unarisation+-- it encodes. See also Note [Getting from RuntimeRep to PrimRep].+-- The @[PrimRep]@ is the final runtime representation /after/ unarisation.+--+-- The result does not contain any VoidRep. runtimeRepPrimRep :: HasDebugCallStack => SDoc -> RuntimeRepType -> [PrimRep] runtimeRepPrimRep doc rr_ty   | Just rr_ty' <- coreView rr_ty@@ -615,9 +617,11 @@   = pprPanic "runtimeRepPrimRep" (doc $$ ppr rr_ty)  -- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that--- it encodes. See also Note [Getting from RuntimeRep to PrimRep]--- The [PrimRep] is the final runtime representation /after/ unarisation--- Returns Nothing if rep can't be determined. Eg. levity polymorphic types.+-- it encodes. See also Note [Getting from RuntimeRep to PrimRep].+-- The @[PrimRep]@ is the final runtime representation /after/ unarisation+-- and does not contain VoidRep.+--+-- Returns @Nothing@ if rep can't be determined. Eg. levity polymorphic types. runtimeRepPrimRep_maybe :: Type -> Maybe [PrimRep] runtimeRepPrimRep_maybe rr_ty   | Just rr_ty' <- coreView rr_ty

@@ -1211,13 +1211,13 @@ putBS bh bs =   BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do     put_ bh l-    putPrim bh l (\op -> BS.memcpy op (castPtr ptr) l)+    putPrim bh l (\op -> copyBytes op (castPtr ptr) l)  getBS :: BinHandle -> IO ByteString getBS bh = do   l <- get bh :: IO Int   BS.create l $ \dest -> do-    getPrim bh l (\src -> BS.memcpy dest src l)+    getPrim bh l (\src -> copyBytes dest src l)  instance Binary ByteString where   put_ bh f = putBS bh f

@@ -6,18 +6,19 @@     , initTmpFs     , forkTmpFsFrom     , mergeTmpFsInto-    , FilesToClean(..)-    , emptyFilesToClean+    , PathsToClean(..)+    , emptyPathsToClean     , TempFileLifetime(..)     , TempDir (..)     , cleanTempDirs     , cleanTempFiles     , cleanCurrentModuleTempFiles+    , keepCurrentModuleTempFiles     , addFilesToClean     , changeTempFilesLifetime     , newTempName     , newTempLibName-    , newTempDir+    , newTempSubDir     , withSystemTempDirectory     , withTempDirectory     )@@ -63,25 +64,29 @@       --       -- Shared with forked TmpFs. -  , tmp_files_to_clean :: IORef FilesToClean+  , tmp_files_to_clean :: IORef PathsToClean       -- ^ Files to clean (per session or per module)       --       -- Not shared with forked TmpFs.+  , tmp_subdirs_to_clean :: IORef PathsToClean+      -- ^ Subdirs to clean (per session or per module)+      --+      -- Not shared with forked TmpFs.   } --- | A collection of files that must be deleted before ghc exits.-data FilesToClean = FilesToClean-    { ftcGhcSession :: !(Set FilePath)-        -- ^ Files that will be deleted at the end of runGhc(T)+-- | A collection of paths that must be deleted before ghc exits.+data PathsToClean = PathsToClean+    { ptcGhcSession :: !(Set FilePath)+        -- ^ Paths that will be deleted at the end of runGhc(T) -    , ftcCurrentModule :: !(Set FilePath)-        -- ^ Files that will be deleted the next time+    , ptcCurrentModule :: !(Set FilePath)+        -- ^ Paths that will be deleted the next time         -- 'cleanCurrentModuleTempFiles' is called, or otherwise at the end of         -- the session.     }  -- | Used when a temp file is created. This determines which component Set of--- FilesToClean will get the temp file+-- PathsToClean will get the temp file data TempFileLifetime   = TFL_CurrentModule   -- ^ A file with lifetime TFL_CurrentModule will be cleaned up at the@@ -93,38 +98,45 @@  newtype TempDir = TempDir FilePath --- | An empty FilesToClean-emptyFilesToClean :: FilesToClean-emptyFilesToClean = FilesToClean Set.empty Set.empty+-- | An empty PathsToClean+emptyPathsToClean :: PathsToClean+emptyPathsToClean = PathsToClean Set.empty Set.empty --- | Merge two FilesToClean-mergeFilesToClean :: FilesToClean -> FilesToClean -> FilesToClean-mergeFilesToClean x y = FilesToClean-    { ftcGhcSession    = Set.union (ftcGhcSession x) (ftcGhcSession y)-    , ftcCurrentModule = Set.union (ftcCurrentModule x) (ftcCurrentModule y)+-- | Merge two PathsToClean+mergePathsToClean :: PathsToClean -> PathsToClean -> PathsToClean+mergePathsToClean x y = PathsToClean+    { ptcGhcSession    = Set.union (ptcGhcSession x) (ptcGhcSession y)+    , ptcCurrentModule = Set.union (ptcCurrentModule x) (ptcCurrentModule y)     }  -- | Initialise an empty TmpFs initTmpFs :: IO TmpFs initTmpFs = do-    files <- newIORef emptyFilesToClean-    dirs  <- newIORef Map.empty-    next  <- newIORef 0+    files   <- newIORef emptyPathsToClean+    subdirs <- newIORef emptyPathsToClean+    dirs    <- newIORef Map.empty+    next    <- newIORef 0     return $ TmpFs-        { tmp_files_to_clean = files-        , tmp_dirs_to_clean  = dirs-        , tmp_next_suffix    = next+        { tmp_files_to_clean   = files+        , tmp_subdirs_to_clean = subdirs+        , tmp_dirs_to_clean    = dirs+        , tmp_next_suffix      = next         }  -- | Initialise an empty TmpFs sharing unique numbers and per-process temporary -- directories with the given TmpFs+--+-- It's not safe to use the subdirs created by the original TmpFs with the+-- forked one. Use @newTempSubDir@ to create new subdirs instead. forkTmpFsFrom :: TmpFs -> IO TmpFs forkTmpFsFrom old = do-    files <- newIORef emptyFilesToClean+    files <- newIORef emptyPathsToClean+    subdirs <- newIORef emptyPathsToClean     return $ TmpFs-        { tmp_files_to_clean = files-        , tmp_dirs_to_clean  = tmp_dirs_to_clean old-        , tmp_next_suffix    = tmp_next_suffix old+        { tmp_files_to_clean   = files+        , tmp_subdirs_to_clean = subdirs+        , tmp_dirs_to_clean    = tmp_dirs_to_clean old+        , tmp_next_suffix      = tmp_next_suffix old         }  -- | Merge the first TmpFs into the second.@@ -132,9 +144,12 @@ -- The first TmpFs is returned emptied. mergeTmpFsInto :: TmpFs -> TmpFs -> IO () mergeTmpFsInto src dst = do-    src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyFilesToClean, s))-    atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergeFilesToClean src_files s, ()))+    src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyPathsToClean, s))+    src_subdirs <- atomicModifyIORef' (tmp_subdirs_to_clean src) (\s -> (emptyPathsToClean, s))+    atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergePathsToClean src_files s, ()))+    atomicModifyIORef' (tmp_subdirs_to_clean dst) (\s -> (mergePathsToClean src_subdirs s, ())) + cleanTempDirs :: Logger -> TmpFs -> IO () cleanTempDirs logger tmpfs    = mask_@@ -142,64 +157,104 @@         ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)         removeTmpDirs logger (Map.elems ds) --- | Delete all files in @tmp_files_to_clean@.+-- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@. cleanTempFiles :: Logger -> TmpFs -> IO () cleanTempFiles logger tmpfs    = mask_-   $ do let ref = tmp_files_to_clean tmpfs-        to_delete <- atomicModifyIORef' ref $-            \FilesToClean-                { ftcCurrentModule = cm_files-                , ftcGhcSession = gs_files-                } -> ( emptyFilesToClean-                     , Set.toList cm_files ++ Set.toList gs_files)-        removeTmpFiles logger to_delete+   $ do removeWith (removeTmpFiles logger) (tmp_files_to_clean tmpfs)+        removeWith (removeTmpSubdirs logger) (tmp_subdirs_to_clean tmpfs)+  where+    removeWith remove ref = do+      to_delete <- atomicModifyIORef' ref $+        \PathsToClean+            { ptcCurrentModule = cm_paths+            , ptcGhcSession = gs_paths+            } -> ( emptyPathsToClean+                  , Set.toList cm_paths ++ Set.toList gs_paths)+      remove to_delete --- | Delete all files in @tmp_files_to_clean@. That have lifetime--- TFL_CurrentModule.+-- | Keep all the paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@+-- that have lifetime TFL_CurrentModule. This function is used when `-keep-tmp-files` is+-- used in an OPTIONS_GHC pragma.+-- This function removes the temporary file from the TmpFs so we no longer remove+-- it at the env when cleanTempFiles is called.+keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO ()+keepCurrentModuleTempFiles logger tmpfs+   = mask_+   $ do to_keep_files <- keep  (tmp_files_to_clean tmpfs)+        to_keep_subdirs <- keep  (tmp_subdirs_to_clean tmpfs)+        -- Remove any folders which contain any files we want to keep from the+        -- directories we are tracking. A new temporary directory will be created+        -- the next time a temporary file is needed (by perhaps another module).+        keepDirs (to_keep_files ++ to_keep_subdirs) (tmp_dirs_to_clean tmpfs)+  where+    keepDirs keeps ref = do+      let keep_dirs = Set.fromList (map takeDirectory keeps)+      atomicModifyIORef' ref  $ \m -> (Map.filter (\fp -> fp `Set.notMember` keep_dirs) m, ())++    keep ref = do+        to_keep <- atomicModifyIORef' ref $+            \ptc@PathsToClean{ptcCurrentModule = cm_paths} ->+                (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths)+        debugTraceMsg logger 2 (text "Keeping:" <+> hsep (map text to_keep))+        return to_keep++-- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@+-- That have lifetime TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a -- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession. cleanCurrentModuleTempFiles :: Logger -> TmpFs -> IO () cleanCurrentModuleTempFiles logger tmpfs    = mask_-   $ do let ref = tmp_files_to_clean tmpfs+   $ do removeWith (removeTmpFiles logger) (tmp_files_to_clean tmpfs)+        removeWith (removeTmpSubdirs logger) (tmp_subdirs_to_clean tmpfs)+  where+    removeWith remove ref = do         to_delete <- atomicModifyIORef' ref $-            \ftc@FilesToClean{ftcCurrentModule = cm_files} ->-                (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files)-        removeTmpFiles logger to_delete+            \ptc@PathsToClean{ptcCurrentModule = cm_paths} ->+                (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths)+        remove to_delete  -- | Ensure that new_files are cleaned on the next call of -- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime. -- If any of new_files are already tracked, they will have their lifetime -- updated. addFilesToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()-addFilesToClean tmpfs lifetime new_files = modifyIORef' (tmp_files_to_clean tmpfs) $-  \FilesToClean-    { ftcCurrentModule = cm_files-    , ftcGhcSession = gs_files+addFilesToClean tmpfs lifetime new_files =+  addToClean (tmp_files_to_clean tmpfs) lifetime new_files++addSubdirsToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()+addSubdirsToClean tmpfs lifetime new_subdirs =+  addToClean (tmp_subdirs_to_clean tmpfs) lifetime new_subdirs++addToClean :: IORef PathsToClean -> TempFileLifetime -> [FilePath] -> IO ()+addToClean ref lifetime new_filepaths = modifyIORef' ref $+  \PathsToClean+    { ptcCurrentModule = cm_paths+    , ptcGhcSession = gs_paths     } -> case lifetime of-      TFL_CurrentModule -> FilesToClean-        { ftcCurrentModule = cm_files `Set.union` new_files_set-        , ftcGhcSession = gs_files `Set.difference` new_files_set+      TFL_CurrentModule -> PathsToClean+        { ptcCurrentModule = cm_paths `Set.union` new_filepaths_set+        , ptcGhcSession = gs_paths `Set.difference` new_filepaths_set         }-      TFL_GhcSession -> FilesToClean-        { ftcCurrentModule = cm_files `Set.difference` new_files_set-        , ftcGhcSession = gs_files `Set.union` new_files_set+      TFL_GhcSession -> PathsToClean+        { ptcCurrentModule = cm_paths `Set.difference` new_filepaths_set+        , ptcGhcSession = gs_paths `Set.union` new_filepaths_set         }   where-    new_files_set = Set.fromList new_files+    new_filepaths_set = Set.fromList new_filepaths  -- | Update the lifetime of files already being tracked. If any files are -- not being tracked they will be discarded. changeTempFilesLifetime :: TmpFs -> TempFileLifetime -> [FilePath] -> IO () changeTempFilesLifetime tmpfs lifetime files = do-  FilesToClean-    { ftcCurrentModule = cm_files-    , ftcGhcSession = gs_files+  PathsToClean+    { ptcCurrentModule = cm_paths+    , ptcGhcSession = gs_paths     } <- readIORef (tmp_files_to_clean tmpfs)   let old_set = case lifetime of-        TFL_CurrentModule -> gs_files-        TFL_GhcSession -> cm_files+        TFL_CurrentModule -> gs_paths+        TFL_GhcSession -> cm_paths       existing_files = [f | f <- files, f `Set.member` old_set]   addFilesToClean tmpfs lifetime existing_files @@ -224,20 +279,32 @@                         addFilesToClean tmpfs lifetime [filename]                         return filename -newTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath-newTempDir logger tmpfs tmp_dir+-- | Create a new temporary subdirectory that doesn't already exist+-- The temporary subdirectory is automatically removed at the end of the+-- GHC session, but its contents aren't. Make sure to leave the directory+-- empty before the end of the session, either by removing content+-- directly or by using @addFilesToClean@.+--+-- If the created subdirectory is not empty, it will not be removed (along+-- with its parent temporary directory) and a warning message will be+-- printed at verbosity 2 and higher.+newTempSubDir :: Logger -> TmpFs -> TempDir -> IO FilePath+newTempSubDir logger tmpfs tmp_dir   = do d <- getTempDir logger tmpfs tmp_dir        findTempDir (d </> "ghc_")   where     findTempDir :: FilePath -> IO FilePath     findTempDir prefix       = do n <- newTempSuffix tmpfs-           let filename = prefix ++ show n-           b <- doesDirectoryExist filename+           let name = prefix ++ show n+           b <- doesDirectoryExist name            if b then findTempDir prefix-                else do createDirectory filename-                        -- see mkTempDir below; this is wrong: -> consIORef (tmp_dirs_to_clean tmpfs) filename-                        return filename+                else (do+                  createDirectory name+                  addSubdirsToClean tmpfs TFL_GhcSession [name]+                  return name)+            `Exception.catchIO` \e -> if isAlreadyExistsError e+                  then findTempDir prefix else ioError e  newTempLibName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix   -> IO (FilePath, FilePath, String)@@ -337,6 +404,12 @@         act      (non_deletees, deletees) = partition isHaskellUserSrcFilename fs++removeTmpSubdirs :: Logger -> [FilePath] -> IO ()+removeTmpSubdirs logger fs+  = traceCmd logger "Deleting temp subdirs"+             ("Deleting: " ++ unwords fs)+             (mapM_ (removeWith logger removeDirectory) fs)  removeWith :: Logger -> (FilePath -> IO ()) -> FilePath -> IO () removeWith logger remover f = remover f `Exception.catchIO`

@@ -3,7 +3,7 @@ -- ./configure.  Make sure you are editing ghc.cabal.in, not ghc.cabal.  Name: ghc-Version: 9.6.2+Version: 9.6.3 License: BSD-3-Clause License-File: LICENSE Author: The GHC Team@@ -86,9 +86,9 @@                    transformers >= 0.5 && < 0.7,                    exceptions == 0.10.*,                    stm,-                   ghc-boot   == 9.6.2,-                   ghc-heap   == 9.6.2,-                   ghci == 9.6.2+                   ghc-boot   == 9.6.3,+                   ghc-heap   == 9.6.3,+                   ghci == 9.6.3      if os(windows)         Build-Depends: Win32  >= 2.3 && < 2.14

@@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: ghc-lib-parser-version: 9.6.2.20231121+version: 9.6.3.20231014 license: BSD-3-Clause license-file: LICENSE category: Development

@@ -21,7 +21,7 @@ cProjectName          = "The Glorious Glasgow Haskell Compilation System"  cBooterVersion        :: String-cBooterVersion        = "9.4.5"+cBooterVersion        = "9.4.4"  cStage                :: String cStage                = show (1 :: Int)

@@ -3,19 +3,19 @@ import Prelude -- See Note [Why do we import Prelude here?]  cProjectGitCommitId   :: String-cProjectGitCommitId   = "7e70df17aee2e39bc599b43e59a52bb30064df4d"+cProjectGitCommitId   = "6819b70a7739205a75f0b4fefcfcc9fdab39cab9"  cProjectVersion       :: String-cProjectVersion       = "9.6.2"+cProjectVersion       = "9.6.3"  cProjectVersionInt    :: String cProjectVersionInt    = "906"  cProjectPatchLevel    :: String-cProjectPatchLevel    = "2"+cProjectPatchLevel    = "3"  cProjectPatchLevel1   :: String-cProjectPatchLevel1   = "2"+cProjectPatchLevel1   = "3"  cProjectPatchLevel2   :: String cProjectPatchLevel2   = "0"

@@ -97,6 +97,9 @@ /* Define to 1 if <alloca.h> works. */ #define HAVE_ALLOCA_H 1 +/* Does the toolchain use ARMv8 outline atomics */+/* #undef HAVE_ARM_OUTLINE_ATOMICS */+ /* Define to 1 if you have the <bfd.h> header file. */ /* #undef HAVE_BFD_H */ @@ -198,6 +201,9 @@  /* Define to 1 if you need to link with libm */ #define HAVE_LIBM 1++/* Define to 1 if you have the `mingwex' library (-lmingwex). */+/* #undef HAVE_LIBMINGWEX */  /* Define to 1 if you have libnuma */ #define HAVE_LIBNUMA 0

@@ -2,7 +2,7 @@ -- ./configure.  Make sure you are editing ghc-bin.cabal.in, not ghc-bin.cabal.  Name: ghc-bin-Version: 9.6.2+Version: 9.6.3 Copyright: XXX -- License: XXX -- License-File: XXX@@ -39,8 +39,8 @@                    filepath   >= 1   && < 1.5,                    containers >= 0.5 && < 0.7,                    transformers >= 0.5 && < 0.7,-                   ghc-boot      == 9.6.2,-                   ghc           == 9.6.2+                   ghc-boot      == 9.6.3,+                   ghc           == 9.6.3      if os(windows)         Build-Depends: Win32  >= 2.3 && < 2.14@@ -58,7 +58,7 @@         Build-depends:             deepseq        == 1.4.*,             ghc-prim       >= 0.5.0 && < 0.11,-            ghci           == 9.6.2,+            ghci           == 9.6.3,             haskeline      == 0.8.*,             exceptions     == 0.10.*,             time           >= 1.8 && < 1.13

@@ -3,7 +3,7 @@ -- ghc-boot-th.cabal.in, not ghc-boot-th.cabal.  name:           ghc-boot-th-version:        9.6.2+version:        9.6.3 license:        BSD3 license-file:   LICENSE category:       GHC

@@ -5,7 +5,7 @@ -- ghc-boot.cabal.  name:           ghc-boot-version:        9.6.2+version:        9.6.3 license:        BSD-3-Clause license-file:   LICENSE category:       GHC@@ -77,7 +77,7 @@                    directory  >= 1.2 && < 1.4,                    filepath   >= 1.3 && < 1.5,                    deepseq    >= 1.4 && < 1.5,-                   ghc-boot-th == 9.6.2+                   ghc-boot-th == 9.6.3     if !os(windows)         build-depends:                    unix       >= 2.7 && < 2.9

@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           ghc-heap-version:        9.6.2+version:        9.6.3 license:        BSD-3-Clause license-file:   LICENSE maintainer:     libraries@haskell.org

@@ -22,6 +22,14 @@ -}  #if !defined(javascript_HOST_ARCH)+-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h+-- We can't include ghc_ffi.h here as we must build with stage0+#if defined(darwin_HOST_OS)+#if !defined(FFI_GO_CLOSURES)+#define FFI_GO_CLOSURES 0+#endif+#endif+ #include <ffi.h> #endif 

@@ -465,7 +465,7 @@ #define MIN_VERSION_ghc_heap(major1,major2,minor) (\   (major1) <  9 || \   (major1) == 9 && (major2) <  6 || \-  (major1) == 9 && (major2) == 6 && (minor) <= 2)+  (major1) == 9 && (major2) == 6 && (minor) <= 3) #endif /* MIN_VERSION_ghc_heap */ #if MIN_VERSION_ghc_heap(8,11,0) instance Binary Heap.StgTSOProfInfo

@@ -2,7 +2,7 @@ -- ../../configure.  Make sure you are editing ghci.cabal.in, not ghci.cabal.  name:           ghci-version:        9.6.2+version:        9.6.3 license:        BSD3 license-file:   LICENSE category:       GHC@@ -77,8 +77,8 @@         containers       >= 0.5 && < 0.7,         deepseq          == 1.4.*,         filepath         == 1.4.*,-        ghc-boot         == 9.6.2,-        ghc-heap         == 9.6.2,+        ghc-boot         == 9.6.3,+        ghc-heap         == 9.6.3,         template-haskell == 2.20.*,         transformers     >= 0.5 && < 0.7 

@@ -56,7 +56,7 @@      build-depends:         base        >= 4.11 && < 4.19,-        ghc-boot-th == 9.6.2,+        ghc-boot-th == 9.6.3,         ghc-prim,         pretty      == 1.1.*