[Git][ghc/ghc][wip/T21694a] Wibbles, add tests

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Mon Aug 22 07:33:47 UTC 2022



Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC


Commits:
cd0b60cf by Simon Peyton Jones at 2022-08-22T08:33:57+01:00
Wibbles, add tests

- - - - -


12 changed files:

- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Utils.hs
- + testsuite/tests/simplCore/should_compile/T21948.hs
- + testsuite/tests/simplCore/should_compile/T21960.hs
- + testsuite/tests/simplCore/should_compile/T21960.stderr
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core.hs
=====================================
@@ -755,7 +755,7 @@ Join points must follow these invariants:
 
          Allowing the idArity to be bigger than the join-arity is
          important in arityType; see GHC.Core.Opt.Arity
-         Note [Arity type for recursive join bindings]
+         Note [Arity for recursive join bindings]
 
          Historical note: see #17294.
 


=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -54,7 +54,7 @@ import GHC.Core.TyCon as TyCon
 import GHC.Core.Coercion.Axiom
 import GHC.Core.Unify
 import GHC.Core.Coercion.Opt ( checkAxInstCo )
-import GHC.Core.Opt.Arity    ( typeArity )
+import GHC.Core.Opt.Arity    ( typeArity, exprIsDeadEnd )
 
 import GHC.Core.Opt.Monad
 


=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -27,7 +27,7 @@ module GHC.Core.Opt.Arity
    , arityTypeArity, idArityType
 
    -- ** Bottoming things
-   , exprBotStrictness_maybe, arityTypeBotSigs_maybe
+   , exprIsDeadEnd, exprBotStrictness_maybe, arityTypeBotSigs_maybe
 
    -- ** typeArity and the state hack
    , typeArity, typeOneShots, typeOneShot
@@ -1248,8 +1248,8 @@ data ArityEnv
        , am_sigs   :: !(IdEnv SafeArityType) }
   -- ^ See Note [Arity analysis] for details about fixed-point iteration.
   -- am_sigs:   NB `SafeArityType` so we can use this in myIsCheapApp
-  -- am_no_eta: see Note [Arity type for recursive join bindings]
-  --            point 5
+  -- am_no_eta: see Note [Arity for recursive join bindings]
+  --            point 5, in GHC.Core.Opt.Simplify.Utils
 
 instance Outputable ArityEnv where
   ppr (AE { am_sigs = sigs, am_no_eta = no_eta })
@@ -1449,8 +1449,9 @@ idArityType v
 
 --------------------
 cheapArityType :: HasDebugCallStack => CoreExpr -> ArityType
-
--- Returns ArityType with IsCheap everywhere
+-- A fast and cheap version of arityType.
+-- Returns an ArityType with IsCheap everywhere
+-- c.f. GHC.Core.Utils.exprIsDeadEnd
 cheapArityType e = go e
   where
     go (Var v)                  = idArityType v
@@ -1499,8 +1500,65 @@ exprArity e = go e
 
     go _                           = 0
 
-{- Note [No free join points in arityType]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+exprIsDeadEnd :: CoreExpr -> Bool
+-- See Note [Bottoming expressions]
+-- This function is, in effect, just a specialised (and hence cheap)
+--    version of cheapArityType
+-- See also exprBotStrictness_maybe, which uses cheapArityType
+exprIsDeadEnd e
+  = go 0 e
+  where
+    go :: Arity -> CoreExpr -> Bool
+    -- (go n e) = True <=> expr applied to n value args is bottom
+    go _ (Lit {})                = False
+    go _ (Type {})               = False
+    go _ (Coercion {})           = False
+    go n (App e a) | isTypeArg a = go n e
+                   | otherwise   = go (n+1) e
+    go n (Tick _ e)              = go n e
+    go n (Cast e _)              = go n e
+    go n (Let _ e)               = go n e
+    go n (Lam v e) | isTyVar v   = go n e
+                   | otherwise   = False
+
+    go _ (Case _ _ _ alts)       = null alts
+       -- See Note [Empty case alternatives] in GHC.Core
+
+    go n (Var v) | isDeadEndAppSig (idDmdSig v) n = True
+                 | isEmptyTy (idType v)           = True
+                 | otherwise                      = False
+
+{- Note [Bottoming expressions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A bottoming expression is guaranteed to diverge, or raise an
+exception.  We can test for it in two different ways, and exprIsDeadEnd
+checks for both of these situations:
+
+* Visibly-bottom computations.  For example
+      (error Int "Hello")
+  is visibly bottom.  The strictness analyser also finds out if
+  a function diverges or raises an exception, and puts that info
+  in its strictness signature.
+
+* Empty types.  If a type is empty, its only inhabitant is bottom.
+  For example:
+      data T
+      f :: T -> Bool
+      f = \(x:t). case x of Bool {}
+  Since T has no data constructors, the case alternatives are of course
+  empty.  However note that 'x' is not bound to a visibly-bottom value;
+  it's the *type* that tells us it's going to diverge.
+
+A GADT may also be empty even though it has constructors:
+        data T a where
+          T1 :: a -> T Bool
+          T2 :: T Int
+        ...(case (x::T Char) of {})...
+Here (T Char) is uninhabited.  A more realistic case is (Int ~ Bool),
+which is likewise uninhabited.
+
+Note [No free join points in arityType]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Suppose we call arityType on this expression (EX1)
    \x . case x of True  -> \y. e
                   False -> $j 3
@@ -1524,8 +1582,8 @@ with an assert in the Var case of arityType.)
 Wrinkles
 
 * We /do/ allow free join point when doing findRhsArity for join-point
-  right-hand sides. See Note [Arity type for recursive join bindings]
-  point (5).
+  right-hand sides. See Note [Arity for recursive join bindings]
+  point (5) in GHC.Core.Opt.Simplify.Utils.
 
 * The invariant (no free join point in arityType) risks being
   invalidated by one very narrow special case: runRW#
@@ -1580,59 +1638,8 @@ recursively bound Ids.  So for non-join-point bindings we satisfy
 ourselves with whizzing up up an ArityType from the idArity of the
 function, via idArityType.
 
-But see Note [Arity type for recursive join bindings] for dark corners.
-
-Note [Arity type for recursive join bindings]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-  f x = joinrec j 0 = \ a b c -> (a,x,b)
-                j n = j (n-1)
-        in j 20
-
-Obviously `f` should get arity 4.  But it's a bit tricky:
-
-1. Remember, we don't eta-expand join points; see GHC.Core.Opt.Simplify.Utils
-   Note [Do not eta-expand join points].
-
-2. But even though we aren't going to eta-expand it, we still want `j` to get
-   idArity=4, via the findRhsArity fixpoint.  Then when we are doing findRhsArity
-   for `f`, we'll call arityType on f's RHS:
-    - At the letrec-binding for `j` we'll whiz up an arity-4 ArityType
-      for `j` (Note [arityType for let-bindings])
-    - At the occurrence (j 20) that arity-4 ArityType will leave an arity-3
-      result.
-
-3. All this, even though j's /join-arity/ (stored in the JoinId) is 1.
-   This is is the Main Reason that we want the idArity to sometimes be
-   larger than the join-arity c.f. Note [Invariants on join points] item 2b
-   in GHC.Core.
-
-4. Be very careful of things like this (#21755):
-     g x = let j 0 = \y -> (x,y)
-               j n = expensive n `seq` j (n-1)
-           in j x
-   Here we do /not/ want eta-expand `g`, lest we duplicate all those
-   (expensive n) calls.
-
-   But it's fine: the findRhsArity fixpoint calculation will compute arity-1
-   for `j` (not arity 2); and that's just what we want. But we do need that
-   fixpoint.
-
-   Historical note: an earlier version of GHC did a hack in which we gave
-   join points an ArityType of ABot, but that did not work with this #21755
-   case.
-
-5. arityType does not usually expect to encounter free join points;
-   see Note [No free join points in arityType].  But consider
-          f x = join    j1 y = .... in
-                joinrec j2 z = ...j1 y... in
-                j2 v
-
-   When doing findRhsArity on `j2` we'll encounter the free `j1`.
-   But that is fine, because we aren't going to eta-expand `j2`;
-   we just want to know its arity.  So we have a flag am_no_eta,
-   switched on when doing findRhsArity on a join point RHS. If
-   the flag is on, we allow free join points, but not otherwise.
+But see Note [Arity for recursive join bindings] in
+GHC.Core.Opt.Simplify.Utils for dark corners.
 -}
 
 {-


=====================================
compiler/GHC/Core/Opt/FloatOut.hs
=====================================
@@ -219,13 +219,6 @@ floatBind :: LevelledBind -> (FloatStats, FloatBinds, [CoreBind])
   -- See Note [Floating out of Rec rhss] for why things get arranged this way.
 floatBind (NonRec (TB var _) rhs)
   = case (floatRhs var rhs) of { (fs, rhs_floats, rhs') ->
-
-        -- A tiresome hack:
-        -- see Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels
---    let rhs'' | isDeadEndId var
---              , exprArity rhs' < idArity var = etaExpand (idArity var) rhs'
---              | otherwise                    = rhs'
-
       (fs, rhs_floats, [NonRec var rhs']) }
 
 floatBind (Rec pairs)


=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -976,16 +976,6 @@ Id, *immediately*, for three reasons:
     thing is based on the cheap-and-cheerful exprIsDeadEnd, I'm not sure
     that it'll nail all such cases.
 
-Note [Bottoming floats: eta expansion] c.f Note [Bottoming floats]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Tiresomely, though, the simplifier has an invariant that the manifest
-arity of the RHS should be the same as the arity; but we can't call
-etaExpand during GHC.Core.Opt.SetLevels because it works over a decorated form of
-CoreExpr.  So we do the eta expansion later, in GHC.Core.Opt.FloatOut.
-But we should only eta-expand if the RHS doesn't already have the right
-exprArity, otherwise we get unnecessary top-level bindings if the RHS was
-trivial after the next run of the Simplifier.
-
 Note [Case MFEs]
 ~~~~~~~~~~~~~~~~
 We don't float a case expression as an MFE from a strict context.  Why not?


=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -39,7 +39,7 @@ import GHC.Core.Unfold
 import GHC.Core.Unfold.Make
 import GHC.Core.Utils
 import GHC.Core.Opt.Arity ( ArityType, exprArity, arityTypeBotSigs_maybe
-                          , pushCoTyArg, pushCoValArg
+                          , pushCoTyArg, pushCoValArg, exprIsDeadEnd
                           , typeArity, arityTypeArity, etaExpandAT )
 import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )
 import GHC.Core.FVs     ( mkRuleInfo )


=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1787,7 +1787,8 @@ tryEtaExpandRhs env (BC_Join is_rec _) bndr rhs
     -- these are used to set the bndr's IdInfo (#15517)
     -- Note [Invariants on join points] invariant 2b, in GHC.Core
   where
-    -- See Note [Arity computation for join points]
+    -- See Note [Arity for non-recursive join bindings]
+    -- and Note [Arity for recursive join bindings]
     arity_type = case is_rec of
                    NonRecursive -> cheapArityType rhs
                    Recursive    -> findRhsArity (seArityOpts env) Recursive
@@ -1932,17 +1933,67 @@ CorePrep comes around, the code is very likely to look more like this:
              $j2 = if n > 0 then $j1
                             else (...) eta
 
-Note [Arity computation for join points]
+Note [Arity for recursive join bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For /recursive/ join points we want the full glory of findRhsArity,
-with its fixpont computation.  Why?  See GHC.Core.Opt.Arity
-Note [Arity type for recursive join bindings].
-
-But for /non-recursive/ join points, findRhsArity will call arityType.
-And that can be expensive when we have deeply nested join points:
-   join j1 x1 = join j2 x2 = join j3 x3 = blah3
-                             in blah2
-                in blah1
+Consider
+  f x = joinrec j 0 = \ a b c -> (a,x,b)
+                j n = j (n-1)
+        in j 20
+
+Obviously `f` should get arity 4.  But it's a bit tricky:
+
+1. Remember, we don't eta-expand join points; see
+   Note [Do not eta-expand join points].
+
+2. But even though we aren't going to eta-expand it, we still want `j` to get
+   idArity=4, via the findRhsArity fixpoint.  Then when we are doing findRhsArity
+   for `f`, we'll call arityType on f's RHS:
+    - At the letrec-binding for `j` we'll whiz up an arity-4 ArityType
+      for `j` (See Note [arityType for let-bindings] in GHC.Core.Opt.Arity)
+    - At the occurrence (j 20) that arity-4 ArityType will leave an arity-3
+      result.
+
+3. All this, even though j's /join-arity/ (stored in the JoinId) is 1.
+   This is is the Main Reason that we want the idArity to sometimes be
+   larger than the join-arity c.f. Note [Invariants on join points] item 2b
+   in GHC.Core.
+
+4. Be very careful of things like this (#21755):
+     g x = let j 0 = \y -> (x,y)
+               j n = expensive n `seq` j (n-1)
+           in j x
+   Here we do /not/ want eta-expand `g`, lest we duplicate all those
+   (expensive n) calls.
+
+   But it's fine: the findRhsArity fixpoint calculation will compute arity-1
+   for `j` (not arity 2); and that's just what we want. But we do need that
+   fixpoint.
+
+   Historical note: an earlier version of GHC did a hack in which we gave
+   join points an ArityType of ABot, but that did not work with this #21755
+   case.
+
+5. arityType does not usually expect to encounter free join points;
+   see GHC.Core.Opt.Arity Note [No free join points in arityType].
+   But consider
+          f x = join    j1 y = .... in
+                joinrec j2 z = ...j1 y... in
+                j2 v
+
+   When doing findRhsArity on `j2` we'll encounter the free `j1`.
+   But that is fine, because we aren't going to eta-expand `j2`;
+   we just want to know its arity.  So we have a flag am_no_eta,
+   switched on when doing findRhsArity on a join point RHS. If
+   the flag is on, we allow free join points, but not otherwise.
+
+
+Note [Arity for non-recursive join bindings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+So much for recursive join bindings (see previous Note).  What about
+/non-recursive/ones?  If we just call findRhsArity, it will call
+arityType.  And that can be expensive when we have deeply nested join
+points:
+  join j1 x1 = join j2 x2 = join j3 x3 = blah3 in blah2 in blah1
 (e.g. test T18698b).
 
 So we call cheapArityType instead.  It's good enough for practical
@@ -1951,6 +2002,7 @@ purposes.
 (Side note: maybe we should use cheapArity for the RHS of let bindings
 in the main arityType function.)
 
+
 ************************************************************************
 *                                                                      *
 \subsection{Floating lets out of big lambdas}


=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -23,7 +23,7 @@ module GHC.Core.Utils (
         -- * Properties of expressions
         exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes,
         mkFunctionType,
-        exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsDeadEnd,
+        exprIsDupable, exprIsTrivial, getIdFromTrivialExpr,
         getIdFromTrivialExpr_maybe,
         exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
         exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprOkForSpecEval,
@@ -1073,69 +1073,8 @@ getIdFromTrivialExpr_maybe e
     go (Var v) = Just v
     go _       = Nothing
 
-{-
-exprIsDeadEnd is a very cheap and cheerful function; it may return
-False for bottoming expressions, but it never costs much to ask.  See
-also GHC.Core.Opt.Arity.exprBotStrictness_maybe, but that's a bit more
-expensive.
--}
 
-exprIsDeadEnd :: CoreExpr -> Bool
--- See Note [Bottoming expressions]
-exprIsDeadEnd e
-  = go 0 e
-  where
-    go :: Arity -> CoreExpr -> Bool
-    -- (go n e) = True <=> expr applied to n value args is bottom
-    go _ (Lit {})                = False
-    go _ (Type {})               = False
-    go _ (Coercion {})           = False
-    go n (App e a) | isTypeArg a = go n e
-                   | otherwise   = go (n+1) e
-    go n (Tick _ e)              = go n e
-    go n (Cast e _)              = go n e
-    go n (Let _ e)               = go n e
-    go n (Lam v e) | isTyVar v   = go n e
-                   | otherwise   = False
-
-    go _ (Case _ _ _ alts)       = null alts
-       -- See Note [Empty case alternatives] in GHC.Core
-
-    go n (Var v) | isDeadEndAppSig (idDmdSig v) n = True
-                 | isEmptyTy (idType v)           = True
-                 | otherwise                      = False
-
-{- Note [Bottoming expressions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A bottoming expression is guaranteed to diverge, or raise an
-exception.  We can test for it in two different ways, and exprIsDeadEnd
-checks for both of these situations:
-
-* Visibly-bottom computations.  For example
-      (error Int "Hello")
-  is visibly bottom.  The strictness analyser also finds out if
-  a function diverges or raises an exception, and puts that info
-  in its strictness signature.
-
-* Empty types.  If a type is empty, its only inhabitant is bottom.
-  For example:
-      data T
-      f :: T -> Bool
-      f = \(x:t). case x of Bool {}
-  Since T has no data constructors, the case alternatives are of course
-  empty.  However note that 'x' is not bound to a visibly-bottom value;
-  it's the *type* that tells us it's going to diverge.
-
-A GADT may also be empty even though it has constructors:
-        data T a where
-          T1 :: a -> T Bool
-          T2 :: T Int
-        ...(case (x::T Char) of {})...
-Here (T Char) is uninhabited.  A more realistic case is (Int ~ Bool),
-which is likewise uninhabited.
-
-
-************************************************************************
+{- *********************************************************************
 *                                                                      *
              exprIsDupable
 *                                                                      *


=====================================
testsuite/tests/simplCore/should_compile/T21948.hs
=====================================
@@ -0,0 +1,11 @@
+module T21948 where
+
+import GHC.Int( Int64 )
+
+nf' :: (b -> ()) -> (a -> b) -> a -> (Int64 -> IO ())
+nf' reduce f x = go
+  where
+    go n | n <= 0    = return ()
+         | otherwise = let !y = f x
+                       in reduce y `seq` go (n-1)
+{-# NOINLINE nf' #-}


=====================================
testsuite/tests/simplCore/should_compile/T21960.hs
=====================================
@@ -0,0 +1,102 @@
+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,
+    UnliftedFFITypes #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
+-- |
+-- Module      : Data.Text.Encoding
+-- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan,
+--               (c) 2009 Duncan Coutts,
+--               (c) 2008, 2009 Tom Harper
+--               (c) 2021 Andrew Lelechenko
+--
+-- License     : BSD-style
+-- Maintainer  : bos at serpentine.com
+-- Portability : portable
+--
+-- Functions for converting 'Text' values to and from 'ByteString',
+-- using several standard encodings.
+--
+-- To gain access to a much larger family of encodings, use the
+-- <http://hackage.haskell.org/package/text-icu text-icu package>.
+
+module Data.Text.Encoding
+    (
+    encodeUtf8BuilderEscaped
+    ) where
+
+import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
+
+import Control.Exception (evaluate, try)
+import Control.Monad.ST (runST, ST)
+import Data.Bits (shiftR, (.&.))
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Internal as B
+import qualified Data.ByteString.Short.Internal as SBS
+import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode, lenientDecode)
+import Data.Text.Internal (Text(..), safe, empty, append)
+import Data.Text.Internal.Unsafe (unsafeWithForeignPtr)
+import Data.Text.Internal.Unsafe.Char (unsafeWrite)
+import Data.Text.Unsafe (unsafeDupablePerformIO)
+import Data.Word (Word8)
+import Foreign.C.Types (CSize(..))
+import Foreign.Ptr (Ptr, minusPtr, plusPtr)
+import Foreign.Storable (poke, peekByteOff)
+import GHC.Exts (byteArrayContents#, unsafeCoerce#)
+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(PlainPtr))
+import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
+import qualified Data.ByteString.Builder.Prim as BP
+import qualified Data.ByteString.Builder.Prim.Internal as BP
+import Data.Text.Internal.Encoding.Utf8 (utf8DecodeStart, utf8DecodeContinue, DecoderResult(..))
+import qualified Data.Text.Array as A
+import qualified Data.Text.Internal.Encoding.Fusion as E
+import qualified Data.Text.Internal.Fusion as F
+import Data.Text.Internal.ByteStringCompat
+
+
+
+-- | Encode text using UTF-8 encoding and escape the ASCII characters using
+-- a 'BP.BoundedPrim'.
+--
+-- Use this function is to implement efficient encoders for text-based formats
+-- like JSON or HTML.
+--
+-- @since 1.1.0.0
+{-# INLINE encodeUtf8BuilderEscaped #-}
+-- TODO: Extend documentation with references to source code in @blaze-html@
+-- or @aeson@ that uses this function.
+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
+encodeUtf8BuilderEscaped be =
+    -- manual eta-expansion to ensure inlining works as expected
+    \txt -> B.builder (mkBuildstep txt)
+  where
+    bound = max 4 $ BP.sizeBound be
+
+    mkBuildstep (Text arr off len) !k =
+        outerLoop off
+      where
+        iend = off + len
+
+        outerLoop !i0 !br@(B.BufferRange op0 ope)
+          | i0 >= iend       = k br
+          | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
+          -- TODO: Use a loop with an integrated bound's check if outRemaining
+          -- is smaller than 8, as this will save on divisions.
+          | otherwise        = return $ B.bufferFull bound op0 (outerLoop i0)
+          where
+            outRemaining = (ope `minusPtr` op0) `quot` bound
+            inpRemaining = iend - i0
+
+            goPartial !iendTmp = go i0 op0
+              where
+                go !i !op
+                  | i < iendTmp = do
+                    let w = A.unsafeIndex arr i
+                    if w < 0x80
+                      then BP.runB be w op >>= go (i + 1)
+                      else poke op w >> go (i + 1) (op `plusPtr` 1)
+                  | otherwise = outerLoop i (B.BufferRange op ope)
+


=====================================
testsuite/tests/simplCore/should_compile/T21960.stderr
=====================================
@@ -0,0 +1 @@
+ 
\ No newline at end of file


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -422,3 +422,4 @@ test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0
 test('T21801', normal, compile, ['-O -dcore-lint'])
 test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec'])
 test('T21694b', [grep_errmsg(r'Arity=4') ], compile, ['-O -ddump-simpl'])
+test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd0b60cf295d26b584bf04e9b86120143af4324a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd0b60cf295d26b584bf04e9b86120143af4324a
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/20220822/b47e2bfb/attachment-0001.html>


More information about the ghc-commits mailing list