Stashing my local changeswip/T20111

2 files changed, 34 insertions, 3 deletions

diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index 1fa8b02bb7..921d989789 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -47,6 +47,7 @@ import GHC.Types.Unique  ( Unique)
 import GHC.Builtin.Uniques (mkPrimOpIdUnique, mkPrimOpWrapperUnique )
 import GHC.Unit.Types    ( Unit )
 import GHC.Utils.Outputable
+import GHC.Utils.Panic
 import GHC.Data.FastString
 
 {-
@@ -567,7 +568,38 @@ primOpIsDiv op = case op of
   DoubleDivOp     -> True
   _               -> False
 
-
+-- | True of primops that have an externally visible (e.g., from other threads
+-- or processes) side-effect like 'putMVar#', as opposed to a local side-effect
+-- like 'writeMutVar#'.
+--
+-- Like 'primOpIsDiv', this flag should ultimately end up in primops.txt.pp, but
+-- it's such a special case that it can just remain here for now.
+primOpHasExternallyVisibleSideEffects :: PrimOp -> Bool
+primOpHasExternallyVisibleSideEffects op
+  = assertPpr (not res || primOpHasSideEffects op) (ppr op) res
+  where
+    res = case op of
+      -- Array ops generally aren't thread-safe, so they count as local
+      -- side-effects. There's the exception of CAS Ops:
+      CasArrayOp -> True
+      CasSmallArrayOp -> True
+      -- Similarly for ByteArray ops. Exceptions:
+      AtomicReadByteArrayOp_Int -> True
+      AtomicWriteByteArrayOp_Int -> True
+      CasByteArrayOp_Int -> True
+      FetchAddByteArrayOp_Int -> True
+      FetchSubByteArrayOp_Int -> True
+      FetchAndByteArrayOp_Int -> True
+      FetchNandByteArrayOp_Int -> True
+      FetchOrByteArrayOp_Int -> True
+      FetchXorByteArrayOp_Int -> True
+      -- Addr#:
+      InterlockedExchange_Word -> True
+
+
+      RaiseIOOp -> True
+      CatchOp   -> True
+      _         -> False
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index f1554a38ed..5819885c23 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -648,9 +648,8 @@ Note [Which scrutinees may throw precise exceptions]
 This is the specification of 'exprMayThrowPreciseExceptions',
 which is important for Scenario 2 of
 Note [Precise exceptions and strictness analysis] in GHC.Types.Demand.
-Ideally, we'd discover
 
-For a term-level expression @f a1 ... an :: ty@ we determine that
+For a term-level expression @f a1 ... an :: ty@ we return
   1. False  If ty is *not* @State# RealWorld@ or an unboxed tuple thereof.
             This check is done by 'forcesRealWorld'.
             (Why not simply unboxed pairs as above? This is motivated by