Make BCO# lifted

In #17424 Simon PJ noted that there is a potentially unsafe occurrence
of unsafeCoerce#, coercing from an unlifted to lifted type. However,
nowhere in the compiler do we assume that a BCO# is not a thunk.
Moreover, in the case of a CAF the result returned by `createBCO` *will*
be a thunk (as noted in [Updatable CAF BCOs]).  Consequently it seems
better to rather make BCO# a lifted type and rename it to BCO.

3 files changed, 14 insertions, 16 deletions

diff --git a/libraries/ghc-heap/tests/closure_size.hs b/libraries/ghc-heap/tests/closure_size.hs
index d760f22efa..85d860fbf4 100644
--- a/libraries/ghc-heap/tests/closure_size.hs
+++ b/libraries/ghc-heap/tests/closure_size.hs
@@ -12,7 +12,6 @@ data A = A (Array# Int)
 data MA = MA (MutableArray# RealWorld Int)
 data BA = BA ByteArray#
 data MBA = MBA (MutableByteArray# RealWorld)
-data B = B BCO#
 data APC a = APC a
 
 
diff --git a/libraries/ghc-heap/tests/heap_all.hs b/libraries/ghc-heap/tests/heap_all.hs
index 1560d4d9e8..fa536a2d30 100644
--- a/libraries/ghc-heap/tests/heap_all.hs
+++ b/libraries/ghc-heap/tests/heap_all.hs
@@ -197,7 +197,6 @@ data A = A (Array# Int)
 data MA = MA (MutableArray# RealWorld Int)
 data BA = BA ByteArray#
 data MBA = MBA (MutableByteArray# RealWorld)
-data B = B BCO#
 data APC a = APC a
 
 main :: IO ()
@@ -220,9 +219,8 @@ main = do
             (# s1, x #) ->
                 case unsafeFreezeByteArray# x s1 of
                     (# s2, y #) -> (# s2, BA y #)
-    B bco <- IO $ \s ->
-        case newBCO# ba ba a 0# ba s of
-            (# s1, x #) -> (# s1, B x #)
+    bco <- IO $ \s ->
+        newBCO# ba ba a 0# ba s
     APC apc <- IO $ \s ->
         case mkApUpd0# bco of
             (# x #) -> (# s, APC x #)
diff --git a/libraries/ghci/GHCi/CreateBCO.hs b/libraries/ghci/GHCi/CreateBCO.hs
index 96fc4418ff..7098c27fb8 100644
--- a/libraries/ghci/GHCi/CreateBCO.hs
+++ b/libraries/ghci/GHCi/CreateBCO.hs
@@ -23,6 +23,7 @@ import System.IO (fixIO)
 import Control.Monad
 import Data.Array.Base
 import Foreign hiding (newArray)
+import Unsafe.Coerce (unsafeCoerce)
 import GHC.Arr          ( Array(..) )
 import GHC.Exts
 import GHC.IO
@@ -44,7 +45,9 @@ createBCO _   ResolvedBCO{..} | resolvedBCOIsLE /= isLittleEndian
                 , "mixed endianness setup is not supported!"
                 ])
 createBCO arr bco
-   = do BCO bco# <- linkBCO' arr bco
+   = do linked_bco <- linkBCO' arr bco
+        -- Note [Updatable CAF BCOs]
+        -- ~~~~~~~~~~~~~~~~~~~~~~~~~
         -- Why do we need mkApUpd0 here?  Otherwise top-level
         -- interpreted CAFs don't get updated after evaluation.  A
         -- top-level BCO will evaluate itself and return its value
@@ -57,9 +60,10 @@ createBCO arr bco
         --   (c) An AP is always fully saturated, so we *can't* wrap
         --       non-zero arity BCOs in an AP thunk.
         --
+        -- See #17424.
         if (resolvedBCOArity bco > 0)
-           then return (HValue (unsafeCoerce# bco#))
-           else case mkApUpd0# bco# of { (# final_bco #) ->
+           then return (HValue (unsafeCoerce linked_bco))
+           else case mkApUpd0# linked_bco of { (# final_bco #) ->
                   return (HValue final_bco) }
 
 
@@ -102,8 +106,8 @@ mkPtrsArray arr n_ptrs ptrs = do
     fill (ResolvedBCOStaticPtr r) i = do
       writePtrsArrayPtr i (fromRemotePtr r)  marr
     fill (ResolvedBCOPtrBCO bco) i = do
-      BCO bco# <- linkBCO' arr bco
-      writePtrsArrayBCO i bco# marr
+      bco <- linkBCO' arr bco
+      writePtrsArrayBCO i bco marr
     fill (ResolvedBCOPtrBreakArray r) i = do
       BA mba <- localRef r
       writePtrsArrayMBA i mba marr
@@ -130,23 +134,20 @@ writePtrsArrayPtr (I# i) (Ptr a#) (PtrsArr arr) = IO $ \s ->
 writeArrayAddr# :: MutableArray# s a -> Int# -> Addr# -> State# s -> State# s
 writeArrayAddr# marr i addr s = unsafeCoerce# writeArray# marr i addr s
 
-writePtrsArrayBCO :: Int -> BCO# -> PtrsArr -> IO ()
+writePtrsArrayBCO :: Int -> BCO -> PtrsArr -> IO ()
 writePtrsArrayBCO (I# i) bco (PtrsArr arr) = IO $ \s ->
   case (unsafeCoerce# writeArray#) arr i bco s of s' -> (# s', () #)
 
-data BCO = BCO BCO#
-
 writePtrsArrayMBA :: Int -> MutableByteArray# s -> PtrsArr -> IO ()
 writePtrsArrayMBA (I# i) mba (PtrsArr arr) = IO $ \s ->
   case (unsafeCoerce# writeArray#) arr i mba s of s' -> (# s', () #)
 
 newBCO :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> IO BCO
 newBCO instrs lits ptrs arity bitmap = IO $ \s ->
-  case newBCO# instrs lits ptrs arity bitmap s of
-    (# s1, bco #) -> (# s1, BCO bco #)
+  newBCO# instrs lits ptrs arity bitmap s
 
 {- Note [BCO empty array]
-
+   ~~~~~~~~~~~~~~~~~~~~~~
 Lots of BCOs have empty ptrs or nptrs, but empty arrays are not free:
 they are 2-word heap objects.  So let's make a single empty array and
 share it between all BCOs.