diff --git a/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc b/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
index 1610027b380d84d2915950edc3b6ea3c8e25543b..80a29bb16018ca6538f514d7b9f29c7c46d75a08 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
+++ b/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
@@ -1,8 +1,11 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module GHC.Exts.Heap.InfoTable.Types
     ( StgInfoTable(..)
     , EntryFunPtr
-    , HalfWord
+    , HalfWord(..)
     , ItblCodes
     ) where
 
@@ -18,13 +21,16 @@ type ItblCodes = Either [Word8] [Word32]
 #include "ghcautoconf.h"
 -- Ultra-minimalist version specially for constructors
 #if SIZEOF_VOID_P == 8
-type HalfWord = Word32
+type HalfWord' = Word32
 #elif SIZEOF_VOID_P == 4
-type HalfWord = Word16
+type HalfWord' = Word16
 #else
 #error Unknown SIZEOF_VOID_P
 #endif
 
+newtype HalfWord = HalfWord HalfWord'
+    deriving newtype (Enum, Eq, Integral, Num, Ord, Real, Show, Storable)
+
 type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))
 
 -- | This is a somewhat faithful representation of an info table. See
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 9f9e445acc3aec6ab0a7a4a6a8c9442991520921..b745bdb536ee83b8e45cb559f41aacf27d4a10c1 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -498,6 +498,10 @@ instance Binary (FunPtr a) where
   put = put . castFunPtrToPtr
   get = castPtrToFunPtr <$> get
 
+instance Binary Heap.HalfWord where
+  put x = put (fromIntegral x :: Word32)
+  get = fromIntegral <$> (get :: Get Word32)
+
 -- Binary instances to support the GetClosure message
 #if MIN_VERSION_ghc_heap(8,11,0)
 instance Binary Heap.StgTSOProfInfo