From ed0b69dc069a23692bff89cfcab1ad9d61999506 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Thu, 16 Nov 2023 12:08:10 -0500
Subject: [PATCH] base: Do not expose whereFrom# from GHC.Exts

---
 libraries/base/changelog.md                                | 1 +
 libraries/base/src/GHC/Base.hs                             | 7 ++++++-
 libraries/base/src/GHC/Exts.hs                             | 3 ++-
 libraries/ghc-internal/src/GHC/Internal/Base.hs            | 2 +-
 libraries/ghc-internal/src/GHC/Internal/Exts.hs            | 5 +++--
 libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc | 1 +
 testsuite/tests/interface-stability/base-exports.stdout    | 2 --
 .../base-exports.stdout-javascript-unknown-ghcjs           | 2 --
 .../tests/interface-stability/base-exports.stdout-mingw32  | 2 --
 .../tests/interface-stability/base-exports.stdout-ws-32    | 2 --
 10 files changed, 14 insertions(+), 13 deletions(-)

diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 5ffc4d886469..a8af334f4f89 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -47,6 +47,7 @@
     matches a `data` or `data instance` declaration) with all of its
     constructors in scope and the levity of `t` is statically known,
     then the constraint `DataToTag t` can always be solved.
+  * `GHC.Exts` no longer exports the GHC-internal `whereFrom#` primop ([CLC proposal #214](https://github.com/haskell/core-libraries-committee/issues/214))
   * `GHC.InfoProv.InfoProv` now provides a `ipUnitId :: String` field encoding the unit ID of the unit defining the info table ([CLC proposal #214](https://github.com/haskell/core-libraries-committee/issues/214))
 
     ([CLC proposal #104](https://github.com/haskell/core-libraries-committee/issues/104))
diff --git a/libraries/base/src/GHC/Base.hs b/libraries/base/src/GHC/Base.hs
index 2fd16860016f..f770e682707a 100644
--- a/libraries/base/src/GHC/Base.hs
+++ b/libraries/base/src/GHC/Base.hs
@@ -139,7 +139,12 @@ module GHC.Base
     ) where
 
 import GHC.Internal.Base
-import GHC.Prim hiding (dataToTagLarge#, dataToTagSmall#)
+import GHC.Prim hiding (dataToTagLarge#, dataToTagSmall#, whereFrom#)
+   -- Hide dataToTagLarge# because it is expected to break for
+   -- GHC-internal reasons in the near future, and shouldn't
+   -- be exposed from base (not even GHC.Exts)
+   -- whereFrom# is similarly internal.
+
 import GHC.Prim.Ext
 import GHC.Prim.PtrEq
 import GHC.Internal.Err
diff --git a/libraries/base/src/GHC/Exts.hs b/libraries/base/src/GHC/Exts.hs
index 28bf5539a201..6e278f020196 100644
--- a/libraries/base/src/GHC/Exts.hs
+++ b/libraries/base/src/GHC/Exts.hs
@@ -111,10 +111,11 @@ module GHC.Exts
 
 import GHC.Internal.Exts
 import GHC.Internal.ArrayArray
-import GHC.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge# )
+import GHC.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# )
   -- Hide dataToTag# ops because they are expected to break for
   -- GHC-internal reasons in the near future, and shouldn't
   -- be exposed from base (not even GHC.Exts)
+   -- whereFrom# is similarly internal.
 
 import GHC.Prim.Ext
 
diff --git a/libraries/ghc-internal/src/GHC/Internal/Base.hs b/libraries/ghc-internal/src/GHC/Internal/Base.hs
index 24104a511bff..3363d5c6c97f 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Base.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Base.hs
@@ -315,7 +315,7 @@ import GHC.Classes hiding (
 import GHC.CString
 import GHC.Magic
 import GHC.Magic.Dict
-import GHC.Prim hiding (dataToTagSmall#, dataToTagLarge#)
+import GHC.Prim hiding (dataToTagSmall#, dataToTagLarge#, whereFrom#)
   -- Hide dataToTag# ops because they are expected to break for
   -- GHC-internal reasons in the near future, and shouldn't
   -- be exposed from base (not even GHC.Exts)
diff --git a/libraries/ghc-internal/src/GHC/Internal/Exts.hs b/libraries/ghc-internal/src/GHC/Internal/Exts.hs
index 40214b206f2c..0ccc9e5a7f00 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Exts.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Exts.hs
@@ -133,10 +133,11 @@ module GHC.Internal.Exts
         maxTupleSize,
        ) where
 
-import GHC.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge# )
-  -- Hide dataToTag# ops because they are expected to break for
+import GHC.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# )
+  -- Hide dataToTagLarge# because it is expected to break for
   -- GHC-internal reasons in the near future, and shouldn't
   -- be exposed from base (not even GHC.Exts)
+  -- whereFrom# is similarly internal.
 
 import GHC.Types
   hiding ( IO   -- Exported from "GHC.IO"
diff --git a/libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc b/libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
index ce46ed246e20..b1859048932d 100644
--- a/libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
+++ b/libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
@@ -29,6 +29,7 @@ import GHC.Internal.IO.Encoding (utf8)
 import GHC.Internal.Foreign.Storable (peekByteOff)
 import GHC.Internal.ClosureTypes
 import GHC.Internal.Text.Read
+import GHC.Prim (whereFrom##)
 
 data InfoProv = InfoProv {
   ipName :: String,
diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout
index 0e4548eecf85..5561d432ddd5 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout
+++ b/testsuite/tests/interface-stability/base-exports.stdout
@@ -4755,7 +4755,6 @@ module GHC.Base where
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
   when :: forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
@@ -6857,7 +6856,6 @@ module GHC.Exts where
   void# :: (# #)
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
index 952c51ca37b5..7de8b85755ed 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
+++ b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
@@ -4755,7 +4755,6 @@ module GHC.Base where
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
   when :: forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
@@ -6826,7 +6825,6 @@ module GHC.Exts where
   void# :: (# #)
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
index 54dc6fe5d9ef..79f581ca782f 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
@@ -4758,7 +4758,6 @@ module GHC.Base where
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
   when :: forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
@@ -7006,7 +7005,6 @@ module GHC.Exts where
   void# :: (# #)
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
index 0e4548eecf85..5561d432ddd5 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
@@ -4755,7 +4755,6 @@ module GHC.Base where
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
   when :: forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
@@ -6857,7 +6856,6 @@ module GHC.Exts where
   void# :: (# #)
   waitRead# :: forall d. Int# -> State# d -> State# d
   waitWrite# :: forall d. Int# -> State# d -> State# d
-  whereFrom# :: forall a d. a -> Addr# -> State# d -> (# State# d, Int# #)
   word16ToInt16# :: Word16# -> Int16#
   word16ToWord# :: Word16# -> Word#
   word2Double# :: Word# -> Double#
-- 
GitLab