diff --git a/libraries/ghc-internal/src/GHC/Float.hs b/libraries/ghc-internal/src/GHC/Float.hs
index 785e3316c2a210b62ba7b9042136943308fba0f0..ef6de2f187d6ce27039bb689811967d4874bbaf3 100644
--- a/libraries/ghc-internal/src/GHC/Float.hs
+++ b/libraries/ghc-internal/src/GHC/Float.hs
@@ -59,6 +59,8 @@ module GHC.Float
     , rationalToFloat
     , castWord32ToFloat
     , castFloatToWord32
+    , castWord32ToFloat#
+    , castFloatToWord32#
     , float2Double
       -- ** Operations
     , floorFloat
@@ -96,6 +98,8 @@ module GHC.Float
     , rationalToDouble
     , castWord64ToDouble
     , castDoubleToWord64
+    , castWord64ToDouble#
+    , castDoubleToWord64#
     , double2Float
       -- ** Operations
     , floorDouble
@@ -1734,6 +1738,12 @@ read it from memory into the destination register and the best way to do that
 is using CMM.
 -}
 
+-- Deprecated since GHC 9.10.
+{-# DEPRECATED stgDoubleToWord64 "Use castDoubleToWord64# instead" #-}
+{-# DEPRECATED stgWord64ToDouble "Use castWord64ToDouble# instead" #-}
+{-# DEPRECATED stgFloatToWord32  "Use castFloatToWord32# instead" #-}
+{-# DEPRECATED stgWord32ToFloat  "Use castWord32ToFloat# instead" #-}
+
 stgDoubleToWord64 :: Double# -> Word64#
 stgDoubleToWord64 = castDoubleToWord64#
 
diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout
index 8a088eb222c0e1c76e977038efb21bafc12531ed..693ac532a0f1548c6a7a3ca6f804a76d67c14641 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout
+++ b/testsuite/tests/interface-stability/base-exports.stdout
@@ -7118,9 +7118,13 @@ module GHC.Float where
   atanhDouble :: Double -> Double
   atanhFloat :: Float -> Float
   castDoubleToWord64 :: Double -> GHC.Word.Word64
+  castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
   castFloatToWord32 :: Float -> GHC.Word.Word32
+  castFloatToWord32# :: Float# -> GHC.Prim.Word32#
   castWord32ToFloat :: GHC.Word.Word32 -> Float
+  castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
   castWord64ToDouble :: GHC.Word.Word64 -> Double
+  castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
   ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
   ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
   clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
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 e4c47f6be9e86e08800d78fea663ab2e713863c7..a6b02c5099119e3e301def8f9e5cfa5e4c668783 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
+++ b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
@@ -7087,9 +7087,13 @@ module GHC.Float where
   atanhDouble :: Double -> Double
   atanhFloat :: Float -> Float
   castDoubleToWord64 :: Double -> GHC.Word.Word64
+  castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
   castFloatToWord32 :: Float -> GHC.Word.Word32
+  castFloatToWord32# :: Float# -> GHC.Prim.Word32#
   castWord32ToFloat :: GHC.Word.Word32 -> Float
+  castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
   castWord64ToDouble :: GHC.Word.Word64 -> Double
+  castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
   ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
   ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
   clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
index 167d4e0f4085bf8ee27bf21ef4b52af0c0be9a05..e3e3a0961ccfee7b508edfe8229279b52895da8d 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
@@ -7267,9 +7267,13 @@ module GHC.Float where
   atanhDouble :: Double -> Double
   atanhFloat :: Float -> Float
   castDoubleToWord64 :: Double -> GHC.Word.Word64
+  castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
   castFloatToWord32 :: Float -> GHC.Word.Word32
+  castFloatToWord32# :: Float# -> GHC.Prim.Word32#
   castWord32ToFloat :: GHC.Word.Word32 -> Float
+  castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
   castWord64ToDouble :: GHC.Word.Word64 -> Double
+  castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
   ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
   ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
   clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
index 77c3c2e15e4cd430e749ac99ef34b65775ab73fe..b8dfb52ef217e061b19e5ba554960189a93565b8 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
@@ -7118,9 +7118,13 @@ module GHC.Float where
   atanhDouble :: Double -> Double
   atanhFloat :: Float -> Float
   castDoubleToWord64 :: Double -> GHC.Word.Word64
+  castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
   castFloatToWord32 :: Float -> GHC.Word.Word32
+  castFloatToWord32# :: Float# -> GHC.Prim.Word32#
   castWord32ToFloat :: GHC.Word.Word32 -> Float
+  castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
   castWord64ToDouble :: GHC.Word.Word64 -> Double
+  castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
   ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
   ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
   clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int