[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Stop dropping a case whose binder is demanded

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Feb 5 20:08:46 UTC 2024



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
f69a5a96 by Simon Peyton Jones at 2024-02-05T15:08:27-05:00
Stop dropping a case whose binder is demanded

This MR fixes #24251.

See Note [Case-to-let for strictly-used binders]
in GHC.Core.Opt.Simplify.Iteration, plus #24251, for
lots of discussion.

Final Nofib changes over 0.1%:
+-----------------------------------------
|        imaginary/digits-of-e2    -2.16%
|                imaginary/rfib    -0.15%
|                    real/fluid    -0.10%
|                   real/gamteb    -1.47%
|                       real/gg    -0.20%
|                 real/maillist    +0.19%
|                      real/pic    -0.23%
|                      real/scs    -0.43%
|               shootout/n-body    -0.41%
|        shootout/spectral-norm    -0.12%
+========================================
|                     geom mean    -0.05%

Pleasingly, overall executable size is down by just over 1%.

Compile times (in perf/compiler) wobble around a bit +/- 0.5%, but the
geometric mean is -0.1% which seems good.

- - - - -
b7a814b4 by Simon Peyton Jones at 2024-02-05T15:08:27-05:00
Add Note [Bangs in Integer functions]

...to document the bangs in the functions in GHC.Num.Integer

- - - - -
ea6e6ff9 by Andrei Borzenkov at 2024-02-05T15:08:27-05:00
Hide WARNING/DEPRECATED namespacing under -XExplicitNamespaces (#24396)

- - - - -


23 changed files:

- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error/Codes.hs
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/exts/pragmas.rst
- libraries/ghc-bignum/src/GHC/Num/Integer.hs
- libraries/ghc-prim/GHC/Tuple.hs
- testsuite/tests/numeric/should_compile/T19641.stderr
- testsuite/tests/simplCore/should_compile/T15631.hs
- testsuite/tests/simplCore/should_compile/T15631.stdout
- testsuite/tests/simplCore/should_compile/T20103.stderr
- testsuite/tests/simplCore/should_compile/T22428.stderr
- testsuite/tests/simplCore/should_compile/T22611.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/warnings/should_compile/T24396a.hs
- + testsuite/tests/warnings/should_fail/T24396c.hs
- + testsuite/tests/warnings/should_fail/T24396c.stderr
- testsuite/tests/warnings/should_fail/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -2827,30 +2827,73 @@ Note [Case-to-let for strictly-used binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we have this:
    case <scrut> of r { _ -> ..r.. }
-
-where 'r' is used strictly in (..r..), we can safely transform to
+where 'r' is used strictly in (..r..), we /could/ safely transform to
    let r = <scrut> in ...r...
-
-This is a Good Thing, because 'r' might be dead (if the body just
-calls error), or might be used just once (in which case it can be
-inlined); or we might be able to float the let-binding up or down.
-E.g. #15631 has an example.
-
-Note that this can change the error behaviour.  For example, we might
-transform
-    case x of { _ -> error "bad" }
-    --> error "bad"
-which is might be puzzling if 'x' currently lambda-bound, but later gets
-let-bound to (error "good").
-
-Nevertheless, the paper "A semantics for imprecise exceptions" allows
-this transformation. If you want to fix the evaluation order, use
-'pseq'.  See #8900 for an example where the loss of this
-transformation bit us in practice.
-
-See also Note [Empty case alternatives] in GHC.Core.
-
-Historical notes
+As a special case,  we have a plain `seq` like
+   case r of r1 { _ -> ...r1... }
+where `r` is used strictly, we /could/ simply drop the `case` to get
+   ...r....
+
+HOWEVER, there are some serious downsides to this transformation, so
+GHC doesn't do it any longer (#24251):
+
+* Suppose the Simplifier sees
+     case x of y* { __DEFAULT ->
+     let z = case y of { __DEFAULT -> expr } in
+     z+1 }
+  The "y*" means "y is used strictly in its scope.  Now we may:
+   - Eliminate the inner case because `y` is evaluated.
+  Now the demand-info on `y` is not right, because `y` is no longer used
+  strictly in its scope.  But it is hard to spot that without doing a new
+  demand analysis.  So there is a danger that we will subsequently:
+   - Eliminate the outer case because `y` is used strictly
+  Yikes!  We can't eliminate both!
+
+* It introduces space leaks (#24251).  Consider
+      go 0 where go x = x `seq` go (x + 1)
+  It is an infinite loop, true, but it should not leak space. Yet if we drop
+  the `seq`, it will.  Another great example is #21741.
+
+* Dropping the outer `case can change the error behaviour.  For example,
+  we might transform
+       case x of { _ -> error "bad" }    -->     error "bad"
+  which is might be puzzling if 'x' currently lambda-bound, but later gets
+  let-bound to (error "good").  Tht is OK accoring to the paper "A semantics for
+  imprecise exceptions", but see #8900 for an example where the loss of this
+  transformation bit us in practice.
+
+* If we have (case e of x -> f x), where `f` is strict, then it looks as if `x`
+  is strictly used, and we could soundly transform to
+     let x = e in f x
+  But if f's strictness info got worse (which can happen in in obscure cases;
+  see #21392) then we might have turned a non-thunk into a thunk!  Bad.
+
+Lacking this "drop-strictly-used-seq" transformation means we can end up with
+some redundant-looking evals.  For example, consider
+    f x y = case x of DEFAULT ->    -- A redundant-looking eval
+            case y of
+              True  -> case x of { Nothing -> False; Just z  -> z }
+              False -> case x of { Nothing -> True;  Just z  -> z }
+That outer eval will be retained right through to code generation.  But,
+perhaps surprisingly, that is probably a /good/ thing:
+
+   Key point: those inner (case x) expressions will be compiled a simple 'if',
+   because the code generator can see that `x` is, at those points, evaluated
+   and properly tagged.
+
+If we dropped the outer eval, both the inner (case x) expressions would need to
+do a proper eval, pushing a return address, with an info table. See the example
+in #15631 where, in the Description, the (case ys) will be a simple multi-way
+jump.
+
+In fact (#24251), when I stopped GHC implementing the drop-strictly-used-seqs
+transformation, binary sizes fell by 1%, and a few programs actually allocated
+less and ran faster.  A case in point is nofib/imaginary/digits-of-e2. (I'm not
+sure exactly why it improves so much, though.)
+
+Slightly related: Note [Empty case alternatives] in GHC.Core.
+
+Historical notes:
 
 There have been various earlier versions of this patch:
 
@@ -3124,8 +3167,9 @@ doCaseToLet scrut case_bndr
 
   | otherwise  -- Scrut has a lifted type
   = exprIsHNF scrut
-    || isStrUsedDmd (idDemandInfo case_bndr)
-    -- See Note [Case-to-let for strictly-used binders]
+       --    || isStrUsedDmd (idDemandInfo case_bndr)
+       -- We no longer look at the demand on the case binder
+       -- See Note [Case-to-let for strictly-used binders]
 
 --------------------------------------------------
 --      3. Catch-all case


=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -74,6 +74,7 @@ import GHC.Types.Demand
 import GHC.Types.Var.Set
 import GHC.Types.Basic
 
+import GHC.Data.Maybe ( orElse )
 import GHC.Data.OrdList ( isNilOL )
 import GHC.Data.FastString ( fsLit )
 
@@ -2358,6 +2359,44 @@ the outer case scrutinises the same variable as the outer case. This
 transformation is called Case Merging.  It avoids that the same
 variable is scrutinised multiple times.
 
+Wrinkles
+
+(MC1) `tryCaseMerge` "looks though" an inner single-alternative case-on-variable.
+     For example
+       case x of {
+          ...outer-alts...
+          DEFAULT -> case y of (a,b) ->
+                     case x of { A -> rhs1; B -> rhs2 }
+    ===>
+       case x of
+         ...outer-alts...
+         a -> case y of (a,b) -> rhs1
+         B -> case y of (a,b) -> rhs2
+
+    This duplicates the `case y` but it removes the case x; so it is a win
+    in terms of execution time (combining the cases on x) at the cost of
+    perhaps duplicating the `case y`.  A case in point is integerEq, which
+    is defined thus
+        integerEq :: Integer -> Integer -> Bool
+        integerEq !x !y = isTrue# (integerEq# x y)
+    which becomes
+        integerEq
+          = \ (x :: Integer) (y_aAL :: Integer) ->
+              case x of x1 { __DEFAULT ->
+              case y of y1 { __DEFAULT ->
+              case x1 of {
+                IS x2 -> case y1 of {
+                           __DEFAULT -> GHC.Types.False;
+                           IS y2     -> tagToEnum# @Bool (==# x2 y2) };
+                IP x2 -> ...
+                IN x2 -> ...
+    We want to merge the outer `case x` with the inner `case x1`.
+
+    This story is not fully robust; it will be defeated by a let-binding,
+    whih we don't want to duplicate.   But accounting for single-alternative
+    case-on-variable is easy to do, and seems useful in common cases so
+    `tryMergeCase` does it.
+
 Note [Eliminate Identity Case]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         case e of               ===> e
@@ -2537,24 +2576,25 @@ mkCase, mkCase1, mkCase2, mkCase3
 --      1. Merge Nested Cases
 --------------------------------------------------
 
-mkCase mode scrut outer_bndr alts_ty (Alt DEFAULT _ deflt_rhs : outer_alts)
+mkCase mode scrut outer_bndr alts_ty alts
   | sm_case_merge mode
-  , (ticks, Case (Var inner_scrut_var) inner_bndr _ inner_alts)
-       <- stripTicksTop tickishFloatable deflt_rhs
-  , inner_scrut_var == outer_bndr
+  , Just alts' <- tryMergeCase outer_bndr alts
   = do  { tick (CaseMerge outer_bndr)
-
-        ; let wrap_alt (Alt con args rhs) = assert (outer_bndr `notElem` args)
-                                            (Alt con args (wrap_rhs rhs))
-                -- Simplifier's no-shadowing invariant should ensure
-                -- that outer_bndr is not shadowed by the inner patterns
-              wrap_rhs rhs = Let (NonRec inner_bndr (Var outer_bndr)) rhs
-                -- The let is OK even for unboxed binders,
-
-              wrapped_alts | isDeadBinder inner_bndr = inner_alts
-                           | otherwise               = map wrap_alt inner_alts
-
-              merged_alts = mergeAlts outer_alts wrapped_alts
+        ; mkCase1 mode scrut outer_bndr alts_ty alts' }
+        -- Warning: don't call mkCase recursively!
+        -- Firstly, there's no point, because inner alts have already had
+        -- mkCase applied to them, so they won't have a case in their default
+        -- Secondly, if you do, you get an infinite loop, because the bindCaseBndr
+        -- in munge_rhs may put a case into the DEFAULT branch!
+  | otherwise
+  = mkCase1 mode scrut outer_bndr alts_ty alts
+
+tryMergeCase :: OutId -> [OutAlt] -> Maybe [OutAlt]
+-- See Note [Merge Nested Cases]
+tryMergeCase outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
+  = case go 5 (\e -> e) emptyVarSet deflt_rhs of
+       Nothing         -> Nothing
+       Just inner_alts -> Just (mergeAlts outer_alts inner_alts)
                 -- NB: mergeAlts gives priority to the left
                 --      case x of
                 --        A -> e1
@@ -2563,17 +2603,42 @@ mkCase mode scrut outer_bndr alts_ty (Alt DEFAULT _ deflt_rhs : outer_alts)
                 --                      B -> e3
                 -- When we merge, we must ensure that e1 takes
                 -- precedence over e2 as the value for A!
-
-        ; fmap (mkTicks ticks) $
-          mkCase1 mode scrut outer_bndr alts_ty merged_alts
-        }
-        -- Warning: don't call mkCase recursively!
-        -- Firstly, there's no point, because inner alts have already had
-        -- mkCase applied to them, so they won't have a case in their default
-        -- Secondly, if you do, you get an infinite loop, because the bindCaseBndr
-        -- in munge_rhs may put a case into the DEFAULT branch!
-
-mkCase mode scrut bndr alts_ty alts = mkCase1 mode scrut bndr alts_ty alts
+  where
+    go :: Int -> (OutExpr -> OutExpr) -> VarSet -> OutExpr -> Maybe [OutAlt]
+    -- In the call (go wrap free_bndrs rhs), the `wrap` function has free `free_bndrs`;
+    -- so do not push `wrap` under any binders that would shadow `free_bndrs`
+    --
+    -- The 'n' is just a depth-bound to avoid pathalogical quadratic behaviour with
+    --   case x1 of DEFAULT -> case x2 of DEFAULT -> case x3 of DEFAULT -> ...
+    -- when for each `case` we'll look down the whole chain to see if there is
+    -- another `case` on that same variable.  Also all of these (case xi) evals
+    -- get duplicated in each branch of the outer case, so 'n' controls how much
+    -- duplication we are prepared to put up with.
+    go 0 _ _ _ = Nothing
+
+    go n wrap free_bndrs (Tick t rhs)
+       = go n (wrap . Tick t) free_bndrs rhs
+    go _ wrap free_bndrs (Case (Var inner_scrut_var) inner_bndr _ inner_alts)
+       | inner_scrut_var == outer_bndr
+       , let wrap_let rhs' | isDeadBinder inner_bndr = rhs'
+                           | otherwise = Let (NonRec inner_bndr (Var outer_bndr)) rhs'
+                              -- The let is OK even for unboxed binders,
+             free_bndrs' = extendVarSet free_bndrs outer_bndr
+       = Just [ assert (not (any (`elemVarSet` free_bndrs') bndrs)) $
+                Alt con bndrs (wrap (wrap_let rhs))
+              | Alt con bndrs rhs <- inner_alts ]
+    go n wrap free_bndrs (Case (Var inner_scrut) inner_bndr ty inner_alts)
+       | [Alt con bndrs rhs] <- inner_alts -- Wrinkle (MC1)
+       , let wrap_case rhs' = Case (Var inner_scrut) inner_bndr ty $
+                              tryMergeCase inner_bndr alts `orElse` alts
+                where
+                  alts = [Alt con bndrs rhs']
+        = assert (not (outer_bndr `elem` (inner_bndr : bndrs))) $
+         go (n-1) (wrap . wrap_case) (free_bndrs `extendVarSet` inner_scrut) rhs
+
+    go _ _ _ _ = Nothing
+
+tryMergeCase _ _ = Nothing
 
 --------------------------------------------------
 --      2. Eliminate Identity Case


=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -1288,7 +1288,7 @@ data NamespaceSpecifier
   = NoNamespaceSpecifier
   | TypeNamespaceSpecifier (EpToken "type")
   | DataNamespaceSpecifier (EpToken "data")
-  deriving (Data)
+  deriving (Eq, Data)
 
 overlappingNamespaceSpecifiers :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
 overlappingNamespaceSpecifiers NoNamespaceSpecifier _ = True


=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -283,10 +283,13 @@ rnSrcWarnDecls bndr_set decls'
 
    sig_ctxt = TopSigCtxt bndr_set
 
-   rn_deprec (Warning (ns_spec, _) rdr_names txt)
+   rn_deprec w@(Warning (ns_spec, _) rdr_names txt)
        -- ensures that the names are defined locally
      = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what ns_spec . unLoc)
                                 rdr_names
+          ; unlessXOptM LangExt.ExplicitNamespaces $
+            when (ns_spec /= NoNamespaceSpecifier) $
+            addErr (TcRnNamespacedWarningPragmaWithoutFlag w)
           ; txt' <- rnWarningTxt txt
           ; return [(nameOccName nm, txt') | (_, nm) <- names] }
   -- Use the OccName from the Name we looked up, rather than from the RdrName,


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1889,6 +1889,17 @@ instance Diagnostic TcRnMessage where
             | otherwise
             = text "they are not unfilled metavariables"
 
+    TcRnNamespacedWarningPragmaWithoutFlag warning@(Warning (kw, _) _ txt) -> mkSimpleDecorated $
+      vcat [ text "Illegal use of the" <+> quotes (ppr kw) <+> text "keyword:"
+           , nest 2 (ppr warning)
+           , text "in a" <+> pragma_type <+> text "pragma"
+           ]
+      where
+        pragma_type = case txt of
+          WarningTxt{} -> text "WARNING"
+          DeprecatedTxt{} -> text "DEPRECATED"
+
+  diagnosticReason :: TcRnMessage -> DiagnosticReason
   diagnosticReason = \case
     TcRnUnknownMessage m
       -> diagnosticReason m
@@ -2512,6 +2523,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnInvalidDefaultedTyVar{}
       -> ErrorWithoutFlag
+    TcRnNamespacedWarningPragmaWithoutFlag{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -3170,6 +3183,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnInvalidDefaultedTyVar{}
       -> noHints
+    TcRnNamespacedWarningPragmaWithoutFlag{}
+      -> [suggestExtension LangExt.ExplicitNamespaces]
 
   diagnosticCode = constructorCode
 


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -4205,6 +4205,13 @@ data TcRnMessage where
       -> NE.NonEmpty TcTyVar  -- ^ The invalid type variables of the proposal
       -> TcRnMessage
 
+  {-| TcRnNamespacedWarningPragmaWithoutFlag is an error that occurs when
+      a namespace specifier is used in {-# WARNING ... #-} or {-# DEPRECATED ... #-}
+      pragmas without the -XExplicitNamespaces extension enabled
+
+  -}
+  TcRnNamespacedWarningPragmaWithoutFlag :: WarnDecl GhcPs -> TcRnMessage
+
   deriving Generic
 
 


=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -600,6 +600,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnDeprecatedInvisTyArgInConPat"              = 69797
   GhcDiagnosticCode "TcRnInvalidDefaultedTyVar"                     = 45625
   GhcDiagnosticCode "TcRnIllegalTermLevelUse"                       = 01928
+  GhcDiagnosticCode "TcRnNamespacedWarningPragmaWithoutFlag"        = 14995
 
   -- TcRnTypeApplicationsDisabled
   GhcDiagnosticCode "TypeApplication"                               = 23482


=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -75,9 +75,10 @@ Language
 
 - GHC Proposal `#65 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0065-type-infix.rst>`_
   "Require namespacing fixity declarations for type names and WARNING/DEPRECATED pragmas" has been partially implemented.
-  Now you can specify namespace of a name that you want to warn about or deprecate: ::
+  Now, with :extension:`ExplicitNamespaces` enabled, you can specify the
+  namespace of a name that you want to warn about or deprecate: ::
 
-    {-# DEPRACATED type D "Use `()` instead" #-} -- this will deprecate type D, but will not touch pattern synonym
+    {-# DEPRECATED type D "Use `()` instead" #-} -- this will deprecate type D, but will not touch pattern synonym
     data D = MkD
 
     {-# DEPRECATED data D "Use `MkD` instead" #-} -- this will deprecate pattern synonym only


=====================================
docs/users_guide/exts/pragmas.rst
=====================================
@@ -251,7 +251,8 @@ When a deprecated name appears in both value and type namespaces (i.e. punning o
     {-# DEPRECATED D "This will deprecate both the type D and the pattern synonym D" #-}
 
 It is possible to specify the namespace of the name to be warned about
-or deprecated using ``type`` and ``data`` specifiers: ::
+or deprecated using ``type`` and ``data`` specifiers, but this feature
+requires enabling :extension:`ExplicitNamespaces`: ::
 
     {-# LANGUAGE PatternSynonyms #-}
 


=====================================
libraries/ghc-bignum/src/GHC/Num/Integer.hs
=====================================
@@ -360,6 +360,24 @@ integerToNaturalThrow (IN _) = raiseUnderflow
 -- Predicates
 ---------------------------------------------------------------------
 
+{- Note [Bangs in Integer functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In this module some functions have banged arguments.  E.g.
+    integerNe !x !y = isTrue# (integerNe# x y)
+This will ensure that both argument are evaluated first, and then pattern
+matching takes place just a multi-way jump.
+
+In some cases (e.g. integerMul, integerSub) this actually makes the function
+strict when it would otherwise not be; but in other cases (e.g integerNe) the
+function is strict in both arguments anyway.  In the latter case it's a bit moot
+whether to have the bangs or not; so this Note just documents that there is no
+Deep Reason why they have to be there.  See Note Note [Case-to-let for
+strictly-used binders] in GHC.Core.Opt.Simplify.Iteration for discussion about
+evals on strictly-used binders.
+
+I have not pointed to this Note from every such use.  There are a lot of them!
+-}
+
 -- | Negative predicate
 integerIsNegative# :: Integer -> Bool#
 integerIsNegative# (IS i#) = i# <# 0#
@@ -369,6 +387,7 @@ integerIsNegative# (IN _)  = 1#
 -- | Negative predicate
 integerIsNegative :: Integer -> Bool
 integerIsNegative !i = isTrue# (integerIsNegative# i)
+   -- Note [Bangs in Integer functions]
 
 -- | Zero predicate
 integerIsZero :: Integer -> Bool
@@ -383,26 +402,32 @@ integerIsOne _       = False
 -- | Not-equal predicate.
 integerNe :: Integer -> Integer -> Bool
 integerNe !x !y = isTrue# (integerNe# x y)
+   -- Note [Bangs in Integer functions]
 
 -- | Equal predicate.
 integerEq :: Integer -> Integer -> Bool
 integerEq !x !y = isTrue# (integerEq# x y)
+   -- See Note [Bangs in Integer functions]
 
 -- | Lower-or-equal predicate.
 integerLe :: Integer -> Integer -> Bool
 integerLe !x !y = isTrue# (integerLe# x y)
+   -- See Note [Bangs in Integer functions]
 
 -- | Lower predicate.
 integerLt :: Integer -> Integer -> Bool
 integerLt !x !y = isTrue# (integerLt# x y)
+   -- See Note [Bangs in Integer functions]
 
 -- | Greater predicate.
 integerGt :: Integer -> Integer -> Bool
 integerGt !x !y = isTrue# (integerGt# x y)
+   -- See Note [Bangs in Integer functions]
 
 -- | Greater-or-equal predicate.
 integerGe :: Integer -> Integer -> Bool
 integerGe !x !y = isTrue# (integerGe# x y)
+   -- See Note [Bangs in Integer functions]
 
 -- | Equal predicate.
 integerEq# :: Integer -> Integer -> Bool#
@@ -473,7 +498,7 @@ instance Ord Integer where
 -- | Subtract one 'Integer' from another.
 integerSub :: Integer -> Integer -> Integer
 {-# NOINLINE integerSub #-}
-integerSub !x      (IS 0#) = x
+integerSub !x      (IS 0#) = x     -- Note [Bangs in Integer functions]
 integerSub (IS x#) (IS y#)
   = case subIntC# x# y# of
     (# z#, 0# #) -> IS z#
@@ -548,7 +573,7 @@ integerAdd (IP x) (IN y)
 -- | Multiply two 'Integer's
 integerMul :: Integer -> Integer -> Integer
 {-# NOINLINE integerMul #-}
-integerMul !_       (IS 0#)  = IS 0#
+integerMul !_       (IS 0#)  = IS 0#  -- Note [Bangs in Integer functions]
 integerMul (IS 0#)  _        = IS 0#
 integerMul x        (IS 1#)  = x
 integerMul (IS 1#)  y        = y
@@ -639,6 +664,7 @@ integerAbs n@(IS i)
 -- negative, zero, or positive, respectively
 integerSignum :: Integer -> Integer
 integerSignum !j = IS (integerSignum# j)
+     -- Note [Bangs in Integer functions]
 
 -- | Return @-1#@, @0#@, and @1#@ depending on whether argument is
 -- negative, zero, or positive, respectively
@@ -711,7 +737,7 @@ integerTestBit !i (W# n) = isTrue# (integerTestBit# i n)
 -- Fake 2's complement for negative values (might be slow)
 integerShiftR# :: Integer -> Word# -> Integer
 {-# NOINLINE integerShiftR# #-}
-integerShiftR# !x      0## = x
+integerShiftR# !x      0## = x   -- Note [Bangs in Integer functions]
 integerShiftR# (IS i)  n   = IS (iShiftRA# i (word2Int# n))
   where
     iShiftRA# a b
@@ -728,11 +754,12 @@ integerShiftR# (IN bn) n   =
 -- Fake 2's complement for negative values (might be slow)
 integerShiftR :: Integer -> Word -> Integer
 integerShiftR !x (W# w) = integerShiftR# x w
+   -- Note [Bangs in Integer functions]
 
 -- | Shift-left operation
 integerShiftL# :: Integer -> Word# -> Integer
 {-# NOINLINE integerShiftL# #-}
-integerShiftL# !x      0## = x
+integerShiftL# !x      0## = x  -- Note [Bangs in Integer functions]
 integerShiftL# (IS 0#) _   = IS 0#
 integerShiftL# (IS 1#) n   = integerBit# n
 integerShiftL# (IS i)  n
@@ -747,6 +774,7 @@ integerShiftL# (IN bn) n   = IN (bigNatShiftL# bn n)
 -- negative Integers is different from negative Int's behavior.
 integerShiftL :: Integer -> Word -> Integer
 integerShiftL !x (W# w) = integerShiftL# x w
+    -- Note [Bangs in Integer functions]
 
 -- | Bitwise OR operation
 --
@@ -913,7 +941,7 @@ integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##)
 -- with a division-by-zero fault.
 integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
 {-# NOINLINE integerQuotRem# #-}
-integerQuotRem# !n      (IS 1#) = (# n, IS 0# #)
+integerQuotRem# !n      (IS 1#) = (# n, IS 0# #) -- Note [Bangs in Integer functions]
 integerQuotRem# !n     (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #)
 integerQuotRem# !_      (IS 0#) = case raiseDivZero of
                                     !_ -> (# IS 0#, IS 0# #)
@@ -951,12 +979,13 @@ integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound)
 -- with a division-by-zero fault.
 integerQuotRem :: Integer -> Integer -> (Integer, Integer)
 integerQuotRem !x !y = case integerQuotRem# x y of
-   (# q, r #) -> (q, r)
+  -- Note [Bangs in Integer functions]
+  (# q, r #) -> (q, r)
 
 
 integerQuot :: Integer -> Integer -> Integer
 {-# NOINLINE integerQuot #-}
-integerQuot !n      (IS 1#)  = n
+integerQuot !n      (IS 1#)  = n  -- Note [Bangs in Integer functions]
 integerQuot !n      (IS -1#) = integerNegate n
 integerQuot !_      (IS 0#)  = raiseDivZero
 integerQuot (IS 0#) _        = IS 0#
@@ -977,7 +1006,7 @@ integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q
 
 integerRem :: Integer -> Integer -> Integer
 {-# NOINLINE integerRem #-}
-integerRem !_       (IS 1#) = IS 0#
+integerRem !_       (IS 1#) = IS 0#   -- Note [Bangs in Integer functions]
 integerRem _       (IS -1#) = IS 0#
 integerRem _        (IS 0#) = IS (remInt# 0# 0#)
 integerRem (IS 0#) _        = IS 0#
@@ -999,7 +1028,7 @@ integerRem n d = case integerQuotRem# n d of (# _, r #) -> r
 -- with a division-by-zero fault.
 integerDivMod# :: Integer -> Integer -> (# Integer, Integer #)
 {-# NOINLINE integerDivMod# #-}
-integerDivMod# !n !d
+integerDivMod# !n !d    -- Note [Bangs in Integer functions]
   | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d))
      = let !q' = integerSub q (IS 1#)
            !r' = integerAdd r d
@@ -1014,12 +1043,13 @@ integerDivMod# !n !d
 -- with a division-by-zero fault.
 integerDivMod :: Integer -> Integer -> (Integer, Integer)
 integerDivMod !n !d = case integerDivMod# n d of
+   -- Note [Bangs in Integer functions]
    (# q,r #) -> (q,r)
 
 
 integerDiv :: Integer -> Integer -> Integer
 {-# NOINLINE integerDiv #-}
-integerDiv !n !d
+integerDiv !n !d  -- Note [Bangs in Integer functions]
    -- same-sign ops can be handled by more efficient 'integerQuot'
    | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d
    | True = case integerDivMod# n d of (# q, _ #) -> q
@@ -1027,7 +1057,7 @@ integerDiv !n !d
 
 integerMod :: Integer -> Integer -> Integer
 {-# NOINLINE integerMod #-}
-integerMod !n !d
+integerMod !n !d  -- Note [Bangs in Integer functions]
    -- same-sign ops can be handled by more efficient 'integerRem'
    | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d
    | True = case integerDivMod# n d of (# _, r #) -> r


=====================================
libraries/ghc-prim/GHC/Tuple.hs
=====================================
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, PatternSynonyms #-}
+{-# LANGUAGE NoImplicitPrelude, PatternSynonyms, ExplicitNamespaces #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Tuple


=====================================
testsuite/tests/numeric/should_compile/T19641.stderr
=====================================
@@ -6,7 +6,7 @@ Result size of Tidy Core
 natural_to_word
   = \ eta ->
       case eta of {
-        NS x1 -> Just (W# x1);
+        NS x2 -> Just (W# x2);
         NB ds -> Nothing
       }
 
@@ -14,7 +14,7 @@ integer_to_int
   = \ eta ->
       case eta of {
         IS ipv -> Just (I# ipv);
-        IP x1 -> Nothing;
+        IP x2 -> Nothing;
         IN ds -> Nothing
       }
 


=====================================
testsuite/tests/simplCore/should_compile/T15631.hs
=====================================
@@ -7,5 +7,5 @@ f xs = let ys = reverse xs
           let w = length xs
           in w + length (reverse (case ys of { a:as -> as; [] -> [] }))
 
-
-
+-- Feb 24: because of #24251 we now expect ys to be
+--         evaluated early, and then case-analysed later


=====================================
testsuite/tests/simplCore/should_compile/T15631.stdout
=====================================
@@ -1,6 +1,7 @@
       case GHC.List.$wlenAcc @a (Foo.f2 @a) 0# of v { __DEFAULT ->
+      case reverse @a xs of ys { __DEFAULT ->
       case GHC.List.$wlenAcc @a xs 0# of ww1 { __DEFAULT ->
-      case GHC.List.reverse1 @a xs (GHC.Types.[] @a) of {
+      case ys of {
         [] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww1 v1 };
           case GHC.List.$wlenAcc
                  case Foo.$wf @a xs of ww [Occ=Once1] { __DEFAULT ->


=====================================
testsuite/tests/simplCore/should_compile/T20103.stderr
=====================================
@@ -1,7 +1,12 @@
 
+T20103.hs:7:24: warning: [GHC-63394] [-Wx-partial (in -Wextended-warnings)]
+    In the use of ‘head’
+    (imported from Prelude, but defined in GHC.List):
+    "This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use "Data.List.NonEmpty"."
+
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 136, types: 88, coercions: 25, joins: 0/0}
+  = {terms: 139, types: 89, coercions: 22, joins: 0/0}
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl :: Int
@@ -31,8 +36,9 @@ lvl4 = GHC.CString.unpackCString# lvl3
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule2 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T20103.$trModule2 = "T20103"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
@@ -43,8 +49,9 @@ lvl5 = GHC.CString.unpackCString# T20103.$trModule2
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule4 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
 T20103.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
@@ -110,10 +117,10 @@ lvl16
                  :: CallStack ~R# (?callStack::CallStack)))
 
 Rec {
--- RHS size: {terms: 44, types: 41, coercions: 21, joins: 0/0}
+-- RHS size: {terms: 47, types: 42, coercions: 18, joins: 0/0}
 T20103.$wfoo [InlPrag=[2], Occ=LoopBreaker]
   :: HasCallStack => GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId[StrictWorker([!])], Arity=2, Str=<SL><1L>, Unf=OtherCon []]
+[GblId[StrictWorker([!])], Arity=2, Str=<1L><1L>, Unf=OtherCon []]
 T20103.$wfoo
   = \ ($dIP :: HasCallStack) (ww :: GHC.Prim.Int#) ->
       case ww of ds {
@@ -136,28 +143,26 @@ T20103.$wfoo
                 (GHC.Prim.-# ds 1#)
           };
         0# ->
-          case getCallStack
-                 ($dIP
-                  `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
-                          :: (?callStack::CallStack) ~R# CallStack))
-          of {
+          case $dIP
+               `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
+                       :: (?callStack::CallStack) ~R# CallStack)
+          of wild1
+          { __DEFAULT ->
+          case getCallStack wild1 of {
             [] ->
-              case $dIP
-                   `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
-                           :: (?callStack::CallStack) ~R# CallStack)
-              of wild1 {
-                __DEFAULT -> case lvl16 wild1 of wild2 { };
+              case wild1 of wild2 {
+                __DEFAULT -> case lvl16 wild2 of {};
                 GHC.Stack.Types.FreezeCallStack ds1 ->
                   case GHC.List.head1
                          @([Char], SrcLoc)
-                         (wild1
+                         (wild2
                           `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N)
                                   :: CallStack ~R# (?callStack::CallStack)))
-                  of wild2 {
-                  }
+                  of {}
               };
             : x ds1 -> case x of { (x1, ds2) -> GHC.List.$wlenAcc @Char x1 0# }
           }
+          }
       }
 end Rec }
 
@@ -165,10 +170,10 @@ end Rec }
 foo [InlPrag=[2]] :: HasCallStack => Int -> Int
 [GblId,
  Arity=2,
- Str=<SL><1!P(1L)>,
+ Str=<1L><1!P(1L)>,
  Cpr=1,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
          Tmpl= \ ($dIP [Occ=Once1] :: HasCallStack)
                  (eta [Occ=Once1!] :: Int) ->
@@ -186,22 +191,25 @@ foo
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule3 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T20103.$trModule3 = GHC.Types.TrNameS T20103.$trModule4
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule1 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T20103.$trModule1 = GHC.Types.TrNameS T20103.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T20103.$trModule :: GHC.Types.Module
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T20103.$trModule
   = GHC.Types.Module T20103.$trModule3 T20103.$trModule1
 


=====================================
testsuite/tests/simplCore/should_compile/T22428.stderr
=====================================
@@ -6,8 +6,9 @@ Result size of Tidy Core
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T22428.f1 :: Integer
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T22428.f1 = GHC.Num.Integer.IS 1#
 
 -- RHS size: {terms: 28, types: 10, coercions: 0, joins: 1/1}
@@ -15,8 +16,9 @@ f :: Integer -> Integer -> Integer
 [GblId,
  Arity=2,
  Str=<SL><1L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0] 156 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [0 0] 156 0}]
 f = \ (x :: Integer) (y :: Integer) ->
       joinrec {
         go [InlPrag=INLINE (sat-args=1), Occ=LoopBreaker, Dmd=SC(S,L)]
@@ -24,20 +26,20 @@ f = \ (x :: Integer) (y :: Integer) ->
         [LclId[JoinId(1)(Just [!])],
          Arity=1,
          Str=<1L>,
-         Unf=Unf{Src=StableUser, TopLvl=False, Value=True, ConLike=True,
-                 WorkFree=True, Expandable=True,
+         Unf=Unf{Src=StableUser, TopLvl=False,
+                 Value=True, ConLike=True, WorkFree=True, Expandable=True,
                  Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)}]
         go (ds :: Integer)
-          = case ds of wild {
-              GHC.Num.Integer.IS x1 ->
-                case x1 of {
-                  __DEFAULT -> jump go (GHC.Num.Integer.integerSub wild T22428.f1);
+          = case ds of x1 {
+              GHC.Num.Integer.IS x2 ->
+                case x2 of {
+                  __DEFAULT -> jump go (GHC.Num.Integer.integerSub x1 T22428.f1);
                   0# -> x
                 };
-              GHC.Num.Integer.IP x1 ->
-                jump go (GHC.Num.Integer.integerSub wild T22428.f1);
-              GHC.Num.Integer.IN x1 ->
-                jump go (GHC.Num.Integer.integerSub wild T22428.f1)
+              GHC.Num.Integer.IP x2 ->
+                jump go (GHC.Num.Integer.integerSub x1 T22428.f1);
+              GHC.Num.Integer.IN x2 ->
+                jump go (GHC.Num.Integer.integerSub x1 T22428.f1)
             }; } in
       jump go y
 


=====================================
testsuite/tests/simplCore/should_compile/T22611.stderr
=====================================
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 544, types: 486, coercions: 0, joins: 0/7}
+  = {terms: 562, types: 505, coercions: 0, joins: 0/10}
 
 $WFound
   = \ @a @m conrep conrep1 ->
@@ -54,13 +54,14 @@ $w$sgo15
                             __DEFAULT ->
                               let {
                                 hi1 = or# (uncheckedShiftRL# ww 1#) 9223372036854775808## } in
-                              let { zeros = word2Int# (ctz# ds3) } in
-                              (# Just ipv4, uncheckedShiftRL# hi1 zeros,
+                              let { zeros = ctz# ds3 } in
+                              let { zeros1 = word2Int# zeros } in
+                              (# Just ipv4, uncheckedShiftRL# hi1 zeros1,
                                  or#
                                    (uncheckedShiftRL#
                                       (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#))
-                                      zeros)
-                                   (uncheckedShiftL# hi1 (-# 64# zeros)) #);
+                                      zeros1)
+                                   (uncheckedShiftL# hi1 (-# 64# zeros1)) #);
                             0## ->
                               (# Just ipv4, 0##,
                                  uncheckedShiftRL#
@@ -116,12 +117,13 @@ $w$sgo15
                         __DEFAULT ->
                           let {
                             hi1 = or# (uncheckedShiftRL# ww 1#) 9223372036854775808## } in
-                          let { zeros = word2Int# (ctz# ds3) } in
-                          (# Just ipv4, uncheckedShiftRL# hi1 zeros,
+                          let { zeros = ctz# ds3 } in
+                          let { zeros1 = word2Int# zeros } in
+                          (# Just ipv4, uncheckedShiftRL# hi1 zeros1,
                              or#
                                (uncheckedShiftRL#
-                                  (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#)) zeros)
-                               (uncheckedShiftL# hi1 (-# 64# zeros)) #);
+                                  (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#)) zeros1)
+                               (uncheckedShiftL# hi1 (-# 64# zeros1)) #);
                         0## ->
                           (# Just ipv4, 0##,
                              uncheckedShiftRL#
@@ -138,12 +140,13 @@ $w$sgo15
             __DEFAULT ->
               let {
                 hi1 = or# (uncheckedShiftRL# ww 1#) 9223372036854775808## } in
-              let { zeros = word2Int# (ctz# ds3) } in
-              (# Nothing, uncheckedShiftRL# hi1 zeros,
+              let { zeros = ctz# ds3 } in
+              let { zeros1 = word2Int# zeros } in
+              (# Nothing, uncheckedShiftRL# hi1 zeros1,
                  or#
                    (uncheckedShiftRL#
-                      (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#)) zeros)
-                   (uncheckedShiftL# hi1 (-# 64# zeros)) #);
+                      (or# (uncheckedShiftRL# ds3 1#) (uncheckedShiftL# ww 63#)) zeros1)
+                   (uncheckedShiftL# hi1 (-# 64# zeros1)) #);
             0## ->
               (# Nothing, 0##,
                  uncheckedShiftRL#
@@ -156,7 +159,8 @@ end Rec }
 
 $salterF
   = \ @v @a f1 k1 m ->
-      case $w$sgo15 9223372036854775808## 0## k1 m of
+      case k1 of k2 { __DEFAULT ->
+      case $w$sgo15 9223372036854775808## 0## k2 m of
       { (# ww, ww1, ww2 #) ->
       case f1 ww of {
         NotFound -> NotFound;
@@ -167,18 +171,22 @@ $salterF
                Nothing ->
                  case ww of {
                    Nothing -> m;
-                   Just old -> case $wbogus (##) of { __DEFAULT -> $wgo ww1 ww2 m }
+                   Just old ->
+                     case m of m1 { __DEFAULT ->
+                     case $wbogus (##) of { __DEFAULT -> $wgo ww1 ww2 m1 }
+                     }
                  };
                Just new ->
                  case new of new1 { __DEFAULT ->
                  case ww of {
-                   Nothing -> $winsertAlong ww1 ww2 k1 new1 m;
+                   Nothing -> $winsertAlong ww1 ww2 k2 new1 m;
                    Just ds -> $wreplaceAlong ww1 ww2 new1 m
                  }
                  }
              })
       }
       }
+      }
 
 lvl
   = \ @v ds ->
@@ -190,10 +198,12 @@ lvl
 Rec {
 $wfoo
   = \ @v x subst ->
-      case $salterF lvl x subst of {
+      case x of x1 { __DEFAULT ->
+      case subst of subst1 { __DEFAULT ->
+      case $salterF lvl x1 subst1 of {
         NotFound ->
-          case x of wild1 {
-            Left x1 -> $wfoo wild1 subst;
+          case x1 of wild1 {
+            Left x2 -> $wfoo wild1 subst1;
             Right y ->
               $wfoo
                 (Right
@@ -204,10 +214,12 @@ $wfoo
                       1# -> C# (chr# i#)
                     }
                     }))
-                subst
+                subst1
           };
         Found p q -> (# p, q #)
       }
+      }
+      }
 end Rec }
 
 foo


=====================================
testsuite/tests/simplCore/should_compile/T7360.stderr
=====================================
@@ -1,15 +1,15 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 116, types: 50, coercions: 0, joins: 0/0}
+  = {terms: 119, types: 52, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
 T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo
 [GblId[DataConWrapper],
  Arity=1,
  Str=<SL>,
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (conrep [Occ=Once1!] :: Int) ->
                  case conrep of { GHC.Types.I# unbx [Occ=Once1] ->
@@ -31,8 +31,8 @@ fun1 [InlPrag=NOINLINE[final]] :: Foo -> ()
  Arity=1,
  Str=<1A>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (x [Occ=Once1] :: Foo) ->
                  case T7360.$wfun1 x of { (# #) -> GHC.Tuple.Prim.() }}]
@@ -43,65 +43,75 @@ fun1
 -- RHS size: {terms: 5, types: 1, coercions: 0, joins: 0/0}
 T7360.fun4 :: ()
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
-         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=False, ConLike=False, WorkFree=False, Expandable=False,
+         Guidance=IF_ARGS [] 30 10}]
 T7360.fun4
   = case T7360.$wfun1 T7360.Foo1 of { (# #) -> GHC.Tuple.Prim.() }
 
--- RHS size: {terms: 11, types: 7, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 14, types: 9, coercions: 0, joins: 0/0}
 fun2 :: forall {a}. [a] -> ((), Int)
 [GblId,
  Arity=1,
  Str=<ML>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@a) (x [Occ=Once1] :: [a]) ->
                  (T7360.fun4,
-                  case GHC.List.$wlenAcc @a x 0# of ww1 [Occ=Once1] { __DEFAULT ->
+                  case x of wild [Occ=Once1] { __DEFAULT ->
+                  case GHC.List.$wlenAcc @a wild 0# of ww1 [Occ=Once1] { __DEFAULT ->
                   GHC.Types.I# ww1
+                  }
                   })}]
 fun2
   = \ (@a) (x :: [a]) ->
       (T7360.fun4,
-       case GHC.List.$wlenAcc @a x 0# of ww1 { __DEFAULT ->
+       case x of wild { __DEFAULT ->
+       case GHC.List.$wlenAcc @a wild 0# of ww1 { __DEFAULT ->
        GHC.Types.I# ww1
+       }
        })
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$trModule4 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
 T7360.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7360.$trModule3 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$trModule3 = GHC.Types.TrNameS T7360.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$trModule2 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T7360.$trModule2 = "T7360"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7360.$trModule1 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$trModule1 = GHC.Types.TrNameS T7360.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T7360.$trModule :: GHC.Types.Module
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$trModule
   = GHC.Types.Module T7360.$trModule3 T7360.$trModule1
 
@@ -115,22 +125,25 @@ $krep
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$tcFoo2 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
 T7360.$tcFoo2 = "Foo"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7360.$tcFoo1 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tcFoo1 = GHC.Types.TrNameS T7360.$tcFoo2
 
 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
 T7360.$tcFoo :: GHC.Types.TyCon
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tcFoo
   = GHC.Types.TyCon
       1581370841583180512#Word64
@@ -150,22 +163,25 @@ T7360.$tc'Foo4
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo6 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T7360.$tc'Foo6 = "'Foo1"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo5 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tc'Foo5 = GHC.Types.TrNameS T7360.$tc'Foo6
 
 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo1 :: GHC.Types.TyCon
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tc'Foo1
   = GHC.Types.TyCon
       3986951253261644518#Word64
@@ -178,22 +194,25 @@ T7360.$tc'Foo1
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo8 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T7360.$tc'Foo8 = "'Foo2"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo7 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tc'Foo7 = GHC.Types.TrNameS T7360.$tc'Foo8
 
 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo2 :: GHC.Types.TyCon
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tc'Foo2
   = GHC.Types.TyCon
       17325079864060690428#Word64
@@ -211,22 +230,25 @@ T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo11 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T7360.$tc'Foo11 = "'Foo3"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo10 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tc'Foo10 = GHC.Types.TrNameS T7360.$tc'Foo11
 
 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo3 :: GHC.Types.TyCon
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T7360.$tc'Foo3
   = GHC.Types.TyCon
       3674231676522181654#Word64


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -417,8 +417,10 @@ test('T21391', normal, compile, ['-O -dcore-lint'])
 # T22112: Simply test that dumping the Core doesn't loop becuse of the unfolding and ignore the dump output
 test('T22112', [ grep_errmsg('never matches') ], compile, ['-O -dsuppress-uniques -dno-typeable-binds -fexpose-all-unfoldings -ddump-simpl'])
 test('T21391a', normal, compile, ['-O -dcore-lint'])
+
 # We don't want to see a thunk allocation for the insertBy expression after CorePrep.
-test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques'])
+test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]') ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques'])
+
 test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0 -O'])
 test('T21801', normal, compile, ['-O -dcore-lint'])
 test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec'])


=====================================
testsuite/tests/warnings/should_compile/T24396a.hs
=====================================
@@ -1,3 +1,5 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+
 module T24396a where
 
 class C1


=====================================
testsuite/tests/warnings/should_fail/T24396c.hs
=====================================
@@ -0,0 +1,20 @@
+
+module T24396c where
+
+
+f = id
+
+{-# WARNING data f "warning on data level" #-}
+
+data F
+
+{-# WARNING type F "warning on type level" #-}
+
+
+g = id
+
+{-# DEPRECATED data g "deprecation on data level" #-}
+
+data G
+
+{-# DEPRECATED type G "deprecation on type level" #-}


=====================================
testsuite/tests/warnings/should_fail/T24396c.stderr
=====================================
@@ -0,0 +1,24 @@
+
+T24396c.hs:7:13: error: [GHC-14995]
+    Illegal use of the ‘data’ keyword:
+      data f "warning on data level"
+    in a WARNING pragma
+    Suggested fix: Perhaps you intended to use ExplicitNamespaces
+
+T24396c.hs:11:13: error: [GHC-14995]
+    Illegal use of the ‘type’ keyword:
+      type F "warning on type level"
+    in a WARNING pragma
+    Suggested fix: Perhaps you intended to use ExplicitNamespaces
+
+T24396c.hs:16:16: error: [GHC-14995]
+    Illegal use of the ‘data’ keyword:
+      data g "deprecation on data level"
+    in a DEPRECATED pragma
+    Suggested fix: Perhaps you intended to use ExplicitNamespaces
+
+T24396c.hs:20:16: error: [GHC-14995]
+    Illegal use of the ‘type’ keyword:
+      type G "deprecation on type level"
+    in a DEPRECATED pragma
+    Suggested fix: Perhaps you intended to use ExplicitNamespaces


=====================================
testsuite/tests/warnings/should_fail/all.T
=====================================
@@ -26,3 +26,4 @@ test('WarningCategory5', [extra_files(['WarningCategory1.hs', 'WarningCategory1_
 test('WarningCategory6', [extra_files(['WarningCategory1.hs', 'WarningCategory1_B.hs', 'WarningCategoryModule.hs'])], multimod_compile_fail, ['WarningCategory1', '-v0 -Wno-extended-warnings -Wdeprecations -Werror=warnings-deprecations'])
 test('WarningCategory7', [extra_files(['WarningCategory1.hs', 'WarningCategory1_B.hs', 'WarningCategoryModule.hs'])], multimod_compile_fail, ['WarningCategory1', '-v0 -Werror -w -Wall'])
 test('WarningCategoryInvalid', normal, compile_fail, [''])
+test('T24396c', normal, compile_fail, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac5c3e4a2e5b1cdcefd1c051437211539b73b3c8...ea6e6ff98411e84dfffad9dd418496563babe54a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac5c3e4a2e5b1cdcefd1c051437211539b73b3c8...ea6e6ff98411e84dfffad9dd418496563babe54a
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240205/f336c519/attachment-0001.html>


More information about the ghc-commits mailing list