[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Update and expand atomic modification Haddocks

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue Mar 28 08:51:34 UTC 2023



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


Commits:
4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00
Update and expand atomic modification Haddocks

* The documentation for `atomicModifyIORef` and `atomicModifyIORef'`
  were incomplete, and the documentation for `atomicModifyIORef` was
  out of date. Update and expand.

* Remove a useless lazy pattern match in the definition of
  `atomicModifyIORef`. The pair it claims to match lazily
  was already forced by `atomicModifyIORef2`.

- - - - -
e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00
Document the constructor name for lists

Derived `Data` instances use raw infix constructor names when applicable.
The `Data.Data [a]` instance, if derived, would have a constructor name
of `":"`. However, it actually uses constructor name `"(:)"`. Document this
peculiarity.

See https://github.com/haskell/core-libraries-committee/issues/147

- - - - -
c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00
Make exprIsConApp_maybe a bit cleverer

Addresses #23159.

See Note Note [Exploit occ-info in exprIsConApp_maybe]
in GHC.Core.SimpleOpt.

Compile times go down very slightly, but always go down,
never up.  Good!

Metrics: compile_time/bytes allocated
------------------------------------------------
 CoOpt_Singletons(normal)   -1.8%
           T15703(normal)   -1.2% GOOD

                geo. mean   -0.1%
                minimum     -1.8%
                maximum     +0.0%

Metric Decrease:
    CoOpt_Singletons
    T15703

- - - - -
85387561 by Ryan Scott at 2023-03-28T04:51:27-04:00
Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat

This implements
[CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149).

- - - - -


10 changed files:

- compiler/GHC/Core/SimpleOpt.hs
- libraries/base/Data/Data.hs
- libraries/base/Data/IORef.hs
- libraries/base/Data/Typeable/Internal.hs
- libraries/base/GHC/IORef.hs
- libraries/base/GHC/TypeLits.hs
- libraries/base/GHC/TypeNats.hs
- libraries/base/changelog.md
- + libraries/base/tests/CLC149.hs
- libraries/base/tests/all.T


Changes:

=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -497,13 +497,20 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst })
        | otherwise                = True
 
         -- Unconditionally safe to inline
-    safe_to_inline :: OccInfo -> Bool
-    safe_to_inline IAmALoopBreaker{}                  = False
-    safe_to_inline IAmDead                            = True
-    safe_to_inline OneOcc{ occ_in_lam = NotInsideLam
-                         , occ_n_br = 1 }             = True
-    safe_to_inline OneOcc{}                           = False
-    safe_to_inline ManyOccs{}                         = False
+safe_to_inline :: OccInfo -> Bool
+safe_to_inline IAmALoopBreaker{}                  = False
+safe_to_inline IAmDead                            = True
+safe_to_inline OneOcc{ occ_in_lam = NotInsideLam
+                     , occ_n_br = 1 }             = True
+safe_to_inline OneOcc{}                           = False
+safe_to_inline ManyOccs{}                         = False
+
+do_beta_by_substitution :: Id -> CoreExpr -> Bool
+-- True <=> you can inline (bndr = rhs) by substitution
+-- See Note [Exploit occ-info in exprIsConApp_maybe]
+do_beta_by_substitution bndr rhs
+  = exprIsTrivial rhs                   -- Can duplicate
+    || safe_to_inline (idOccInfo bndr)  -- Occurs at most once
 
 -------------------
 simple_out_bind :: TopLevelFlag
@@ -1078,6 +1085,45 @@ will happen the next time either.
 
 See test T16254, which checks the behavior of newtypes.
 
+Note [Exploit occ-info in exprIsConApp_maybe]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose (#23159) we have a simple data constructor wrapper like this (this one
+might have come from a data family instance):
+   $WK x y = K x y |> co
+Now suppose the simplifier sees
+   case ($WK e1 e2) |> co2 of
+      K p q ->  case q of ...
+
+`exprIsConApp_maybe` expands the wrapper on the fly
+(see Note [beta-reduction in exprIsConApp_maybe]). It effectively expands
+that ($WK e1 e2) to
+   let x = e1; y = e2 in K x y |> co
+
+So the Simplifier might end up producing this:
+   let x = e1; y = e2
+   in case x of ...
+
+But suppose `q` was used just once in the body of the `K p q` alternative; we
+don't want to wait a whole Simplifier iteration to inline that `x`.  (e1 might
+be another constructor for example.)  This would happen if `exprIsConApp_maybe`
+we created a let for every (non-trivial) argument.  So let's not do that when
+the binder is used just once!
+
+Instead, take advantage of the occurrence-info on `x` and `y` in the unfolding
+of `$WK`.  Since in `$WK` both `x` and `y` occur once, we want to effectively
+expand `($WK e1 e2)` to `(K e1 e2 |> co)`.  Hence in
+`do_beta_by_substitution` we say "yes" if
+
+  (a) the RHS is trivial (so we can duplicate it);
+      see call to `exprIsTrivial`
+or
+  (b) the binder occurs at most once (so there is no worry about duplication);
+      see call to `safe_to_inline`.
+
+To see this in action, look at testsuite/tests/perf/compiler/T15703.  The
+initial Simlifier run takes 5 iterations without (b), but only 3 when we add
+(b).
+
 Note [Don't float join points]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 exprIsConApp_maybe should succeed on
@@ -1228,7 +1274,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
        = go subst floats fun (CC (subst_expr subst arg : args) co)
 
     go subst floats (Lam bndr body) (CC (arg:args) co)
-       | exprIsTrivial arg          -- Don't duplicate stuff!
+       | do_beta_by_substitution bndr arg
        = go (extend subst bndr arg) floats body (CC args co)
        | otherwise
        = let (subst', bndr') = subst_bndr subst bndr


=====================================
libraries/base/Data/Data.hs
=====================================
@@ -1136,7 +1136,10 @@ consConstr   = mkConstr listDataType "(:)" [] Infix
 listDataType :: DataType
 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
 
--- | @since 4.0.0.0
+-- | For historical reasons, the constructor name used for @(:)@ is
+-- @"(:)"@. In a derived instance, it would be @":"@.
+--
+-- @since 4.0.0.0
 instance Data a => Data [a] where
   gfoldl _ z []     = z []
   gfoldl f z (x:xs) = z (:) `f` x `f` xs


=====================================
libraries/base/Data/IORef.hs
=====================================
@@ -85,21 +85,45 @@ modifyIORef' ref f = do
 -- is recommended that if you need to do anything more complicated
 -- then using 'Control.Concurrent.MVar.MVar' instead is a good idea.
 --
--- 'atomicModifyIORef' does not apply the function strictly.  This is important
--- to know even if all you are doing is replacing the value.  For example, this
--- will leak memory:
+-- Conceptually,
 --
--- >ref <- newIORef '1'
--- >forever $ atomicModifyIORef ref (\_ -> ('2', ()))
+-- @
+-- atomicModifyIORef ref f = do
+--   -- Begin atomic block
+--   old <- 'readIORef' ref
+--   let r = f old
+--       new = fst r
+--   'writeIORef' ref new
+--   -- End atomic block
+--   case r of
+--     (_new, res) -> pure res
+-- @
 --
--- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem.
+-- The actions in the section labeled \"atomic block\" are not subject to
+-- interference from other threads. In particular, it is impossible for the
+-- value in the 'IORef' to change between the 'readIORef' and 'writeIORef'
+-- invocations.
 --
--- This function imposes a memory barrier, preventing reordering;
--- see "Data.IORef#memmodel" for details.
+-- The user-supplied function is applied to the value stored in the 'IORef',
+-- yielding a new value to store in the 'IORef' and a value to return. After
+-- the new value is (lazily) stored in the 'IORef', @atomicModifyIORef@ forces
+-- the result pair, but does not force either component of the result. To force
+-- /both/ components, use 'atomicModifyIORef''.
+--
+-- Note that
+--
+-- @atomicModifyIORef ref (\_ -> undefined)@
+--
+-- will raise an exception in the calling thread, but will /also/
+-- install the bottoming value in the 'IORef', where it may be read by
+-- other threads.
+--
+-- This function imposes a memory barrier, preventing reordering around the
+-- \"atomic block\"; see "Data.IORef#memmodel" for details.
 --
 atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
 atomicModifyIORef ref f = do
-  (_old, ~(_new, res)) <- atomicModifyIORef2 ref f
+  (_old, (_new, res)) <- atomicModifyIORef2 ref f
   pure res
 
 -- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that


=====================================
libraries/base/Data/Typeable/Internal.hs
=====================================
@@ -272,6 +272,7 @@ typeableInstance rep = withTypeable rep TypeableInstance
 pattern TypeRep :: forall {k :: Type} (a :: k). () => Typeable @k a => TypeRep @k a
 pattern TypeRep <- (typeableInstance -> TypeableInstance)
   where TypeRep = typeRep
+{-# COMPLETE TypeRep #-}
 
 {- Note [TypeRep fingerprints]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
libraries/base/GHC/IORef.hs
=====================================
@@ -134,9 +134,28 @@ atomicSwapIORef (IORef (STRef ref)) new = IO $ \s ->
 
 data Box a = Box a
 
--- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both
--- the value stored in the 'IORef' and the value returned. The new value
--- is installed in the 'IORef' before the returned value is forced.
+-- | A strict version of 'Data.IORef.atomicModifyIORef'.  This forces both the
+-- value stored in the 'IORef' and the value returned.
+--
+-- Conceptually,
+--
+-- @
+-- atomicModifyIORef' ref f = do
+--   -- Begin atomic block
+--   old <- 'readIORef' ref
+--   let r = f old
+--       new = fst r
+--   'writeIORef' ref new
+--   -- End atomic block
+--   case r of
+--     (!_new, !res) -> pure res
+-- @
+--
+-- The actions in the \"atomic block\" are not subject to interference
+-- by other threads. In particular, the value in the 'IORef' cannot
+-- change between the 'readIORef' and 'writeIORef' invocations.
+--
+-- The new value is installed in the 'IORef' before either value is forced.
 -- So
 --
 -- @atomicModifyIORef' ref (\x -> (x+1, undefined))@
@@ -144,8 +163,18 @@ data Box a = Box a
 -- will increment the 'IORef' and then throw an exception in the calling
 -- thread.
 --
--- This function imposes a memory barrier, preventing reordering;
--- see "Data.IORef#memmodel" for details.
+-- @atomicModifyIORef' ref (\x -> (undefined, x))@
+--
+-- and
+--
+-- @atomicModifyIORef' ref (\_ -> undefined)@
+--
+-- will each raise an exception in the calling thread, but will /also/
+-- install the bottoming value in the 'IORef', where it may be read by
+-- other threads.
+--
+-- This function imposes a memory barrier, preventing reordering around
+-- the \"atomic block\"; see "Data.IORef#memmodel" for details.
 --
 -- @since 4.6.0.0
 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b


=====================================
libraries/base/GHC/TypeLits.hs
=====================================
@@ -363,6 +363,7 @@ newtype SSymbol (s :: Symbol) = UnsafeSSymbol String
 pattern SSymbol :: forall s. () => KnownSymbol s => SSymbol s
 pattern SSymbol <- (knownSymbolInstance -> KnownSymbolInstance)
   where SSymbol = symbolSing
+{-# COMPLETE SSymbol #-}
 
 -- An internal data type that is only used for defining the SSymbol pattern
 -- synonym.
@@ -464,6 +465,7 @@ newtype SChar (s :: Char) = UnsafeSChar Char
 pattern SChar :: forall c. () => KnownChar c => SChar c
 pattern SChar <- (knownCharInstance -> KnownCharInstance)
   where SChar = charSing
+{-# COMPLETE SChar #-}
 
 -- An internal data type that is only used for defining the SChar pattern
 -- synonym.


=====================================
libraries/base/GHC/TypeNats.hs
=====================================
@@ -367,6 +367,7 @@ newtype SNat (n :: Nat) = UnsafeSNat Natural
 pattern SNat :: forall n. () => KnownNat n => SNat n
 pattern SNat <- (knownNatInstance -> KnownNatInstance)
   where SNat = natSing
+{-# COMPLETE SNat #-}
 
 -- An internal data type that is only used for defining the SNat pattern
 -- synonym.


=====================================
libraries/base/changelog.md
=====================================
@@ -16,6 +16,8 @@
       ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57))
   * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`.
       ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148))
+  * Add `COMPLETE` pragmas to the `TypeRep`, `SSymbol`, `SChar`, and `SNat` pattern synonyms.
+      ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149))
 
 ## 4.18.0.0 *TBA*
   * Shipped with GHC 9.6.1


=====================================
libraries/base/tests/CLC149.hs
=====================================
@@ -0,0 +1,23 @@
+-- Test the COMPLETE pragmas for SChar, SNat, SSymbol, and TypeRep.
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+module CLC149 where
+
+import Data.Kind
+import GHC.TypeLits
+import Type.Reflection
+
+type Dict :: Constraint -> Type
+data Dict c where
+  Dict :: c => Dict c
+
+sc :: SChar c -> Dict (KnownChar c)
+sc SChar = Dict
+
+sn :: SNat n -> Dict (KnownNat n)
+sn SNat = Dict
+
+ss :: SSymbol s -> Dict (KnownSymbol s)
+ss SSymbol = Dict
+
+tr :: TypeRep a -> Dict (Typeable a)
+tr TypeRep = Dict


=====================================
libraries/base/tests/all.T
=====================================
@@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, [''])
 test('trace', normal, compile_and_run, [''])
 test('listThreads', js_broken(22261), compile_and_run, [''])
 test('inits1tails1', normal, compile_and_run, [''])
+test('CLC149', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7281d5aa8e7acdae876fab25a27f839efebb80f2...853875613f29e528de65779b1afe41a99eb8c539

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7281d5aa8e7acdae876fab25a27f839efebb80f2...853875613f29e528de65779b1afe41a99eb8c539
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/20230328/2358eba5/attachment-0001.html>


More information about the ghc-commits mailing list