Merge branch 'binary-readerT' into 'master'

6 files changed, 882 insertions, 902 deletions

diff --git a/compiler/iface/BinFingerprint.hs b/compiler/iface/BinFingerprint.hs
index 1eef4d67b4..e1a0f8177f 100644
--- a/compiler/iface/BinFingerprint.hs
+++ b/compiler/iface/BinFingerprint.hs
@@ -14,11 +14,12 @@ import GhcPrelude
 
 import Fingerprint
 import Binary
+import Binary.Unsafe (runBuffer)
 import Name
 import PlainPanic
 import Util
 
-fingerprintBinMem :: BinHandle -> IO Fingerprint
+fingerprintBinMem :: BinData -> IO Fingerprint
 fingerprintBinMem bh = withBinBuffer bh f
   where
     f bs =
@@ -29,21 +30,19 @@ fingerprintBinMem bh = withBinBuffer bh f
         in fp `seq` return fp
 
 computeFingerprint :: (Binary a)
-                   => (BinHandle -> Name -> IO ())
+                   => (Name -> Put ())
                    -> a
                    -> IO Fingerprint
 computeFingerprint put_nonbinding_name a = do
-    bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
-    put_ bh a
-    fp <- fingerprintBinMem bh
-    return fp
+  bd <- runBuffer (3 * 1024) (setUserData (put a)) -- just less than a block
+  fingerprintBinMem bd
   where
-    set_user_data bh =
-      setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
+    setUserData =
+      writeState put_nonbinding_name putNameLiterally putFS
 
 -- | Used when we want to fingerprint a structure without depending on the
 -- fingerprints of external Names that it refers to.
-putNameLiterally :: BinHandle -> Name -> IO ()
-putNameLiterally bh name = ASSERT( isExternalName name ) do
-    put_ bh $! nameModule name
-    put_ bh $! nameOccName name
+putNameLiterally :: Name -> Put ()
+putNameLiterally name = ASSERT( isExternalName name ) do
+    put $! nameModule name
+    put $! nameOccName name
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index faee723bd2..35be4b566b 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -46,6 +46,7 @@ import UniqFM
 import UniqSupply
 import Panic
 import Binary
+import Binary.Unsafe (ioP, ioG)
 import SrcLoc
 import ErrUtils
 import FastMutInt
@@ -103,174 +104,166 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
                                     sd
                       QuietBinIFaceReading -> \_ -> return ()
 
-        wantedGot :: String -> a -> a -> (a -> SDoc) -> IO ()
-        wantedGot what wanted got ppr' =
+        wantedGot :: String -> a -> a -> (a -> SDoc) -> Get ()
+        wantedGot what wanted got ppr' = ioG $
             printer (text what <> text ": " <>
                      vcat [text "Wanted " <> ppr' wanted <> text ",",
                            text "got    " <> ppr' got])
 
-        errorOnMismatch :: (Eq a, Show a) => String -> a -> a -> IO ()
-        errorOnMismatch what wanted got =
+        errorOnMismatch :: (Eq a, Show a) => String -> a -> a -> Get ()
+        errorOnMismatch what wanted got = ioG $
             -- This will be caught by readIface which will emit an error
             -- msg containing the iface module name.
             when (wanted /= got) $ throwGhcExceptionIO $ ProgramError
                          (what ++ " (wanted " ++ show wanted
                                ++ ", got "    ++ show got ++ ")")
-    bh <- Binary.readBinMem hi_path
-
-    -- Read the magic number to check that this really is a GHC .hi file
-    -- (This magic number does not change when we change
-    --  GHC interface file format)
-    magic <- get bh
-    wantedGot "Magic" (binaryInterfaceMagic dflags) magic ppr
-    errorOnMismatch "magic number mismatch: old/corrupt interface file?"
-        (binaryInterfaceMagic dflags) magic
-
-    -- Note [dummy iface field]
-    -- read a dummy 32/64 bit value.  This field used to hold the
-    -- dictionary pointer in old interface file formats, but now
-    -- the dictionary pointer is after the version (where it
-    -- should be).  Also, the serialisation of value of type "Bin
-    -- a" used to depend on the word size of the machine, now they
-    -- are always 32 bits.
-    if wORD_SIZE dflags == 4
-        then do _ <- Binary.get bh :: IO Word32; return ()
-        else do _ <- Binary.get bh :: IO Word64; return ()
-
-    -- Check the interface file version and ways.
-    check_ver  <- get bh
-    let our_ver = show hiVersion
-    wantedGot "Version" our_ver check_ver text
-    errorOnMismatch "mismatched interface file versions" our_ver check_ver
-
-    check_way <- get bh
-    let way_descr = getWayDescr dflags
-    wantedGot "Way" way_descr check_way ppr
-    when (checkHiWay == CheckHiWay) $
-        errorOnMismatch "mismatched interface file ways" way_descr check_way
-    getWithUserData ncu bh
+
+    bd <- Binary.readBinData hi_path
+
+    runGetIO bd $ do
+      -- Read the magic number to check that this really is a GHC .hi file
+      -- (This magic number does not change when we change
+      --  GHC interface file format)
+      magic <- get
+      wantedGot "Magic" (binaryInterfaceMagic dflags) magic ppr
+      errorOnMismatch "magic number mismatch: old/corrupt interface file?"
+          (binaryInterfaceMagic dflags) magic
+
+      -- Note [dummy iface field]
+      -- read a dummy 32/64 bit value.  This field used to hold the
+      -- dictionary pointer in old interface file formats, but now
+      -- the dictionary pointer is after the version (where it
+      -- should be).  Also, the serialisation of value of type "Bin
+      -- a" used to depend on the word size of the machine, now they
+      -- are always 32 bits.
+      if wORD_SIZE dflags == 4
+          then do _ <- Binary.get :: Get Word32; return ()
+          else do _ <- Binary.get :: Get Word64; return ()
+
+      -- Check the interface file version and ways.
+      check_ver <- get
+      let our_ver = show hiVersion
+      wantedGot "Version" our_ver check_ver text
+      errorOnMismatch "mismatched interface file versions" our_ver check_ver
+
+      check_way <- get
+      let way_descr = getWayDescr dflags
+      wantedGot "Way" way_descr check_way ppr
+      when (checkHiWay == CheckHiWay) $
+          errorOnMismatch "mismatched interface file ways" way_descr check_way
+      getWithUserData ncu
 
 
 -- | This performs a get action after reading the dictionary and symbol
 -- table. It is necessary to run this before trying to deserialise any
 -- Names or FastStrings.
-getWithUserData :: Binary a => NameCacheUpdater -> BinHandle -> IO a
-getWithUserData ncu bh = do
+getWithUserData :: Binary a => NameCacheUpdater -> Get a
+getWithUserData ncu = do
     -- Read the dictionary
     -- The next word in the file is a pointer to where the dictionary is
     -- (probably at the end of the file)
-    dict_p <- Binary.get bh
-    data_p <- tellBin bh          -- Remember where we are now
-    seekBin bh dict_p
-    dict   <- getDictionary bh
-    seekBin bh data_p             -- Back to where we were before
-
-    -- Initialise the user-data field of bh
-    bh <- do
-        bh <- return $ setUserData bh $ newReadState (error "getSymtabName")
-                                                     (getDictFastString dict)
-        symtab_p <- Binary.get bh     -- Get the symtab ptr
-        data_p <- tellBin bh          -- Remember where we are now
-        seekBin bh symtab_p
-        symtab <- getSymbolTable bh ncu
-        seekBin bh data_p             -- Back to where we were before
-
-        -- It is only now that we know how to get a Name
-        return $ setUserData bh $ newReadState (getSymtabName ncu dict symtab)
-                                               (getDictFastString dict)
-
-    -- Read the interface file
-    get bh
+    dict_p <- Binary.get
+    data_p <- tellG               -- Remember where we are now
+    seekG dict_p
+    dict   <- getDictionary
+    seekG data_p                -- Back to where we were before
+
+    readState (error "getSymtabName") (getDictFastString dict) $ do
+
+      symtab_p <- Binary.get       -- Get the symtab ptr
+      data_p <- tellG              -- Remember where we are now
+      seekG symtab_p
+      symtab <- getSymbolTable ncu
+      seekG data_p                 -- Back to where we were before
+
+      -- It is only now that we know how to get a `Name`
+      readState (getSymtabName ncu dict symtab) (getDictFastString dict) get
 
 -- | Write an interface file
 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
 writeBinIface dflags hi_path mod_iface = do
-    bh <- openBinMem initBinMemSize
-    put_ bh (binaryInterfaceMagic dflags)
 
-   -- dummy 32/64-bit field before the version/way for
-   -- compatibility with older interface file formats.
-   -- See Note [dummy iface field] above.
-    if wORD_SIZE dflags == 4
-        then Binary.put_ bh (0 :: Word32)
-        else Binary.put_ bh (0 :: Word64)
+    bd <- runPutIO $ do
+      put (binaryInterfaceMagic dflags)
+
+      -- dummy 32/64-bit field before the version/way for
+      -- compatibility with older interface file formats.
+      -- See Note [dummy iface field] above.
+      if wORD_SIZE dflags == 4
+        then Binary.put (0 :: Word32)
+        else Binary.put (0 :: Word64)
 
-    -- The version and way descriptor go next
-    put_ bh (show hiVersion)
-    let way_descr = getWayDescr dflags
-    put_  bh way_descr
+      -- The version and way descriptor go next
+      put (show hiVersion)
+      let way_descr = getWayDescr dflags
+      put way_descr
 
+      putWithUserData (ioP . debugTraceMsg dflags 3) mod_iface
 
-    putWithUserData (debugTraceMsg dflags 3) bh mod_iface
     -- And send the result to the file
-    writeBinMem bh hi_path
+    writeBinData bd hi_path
 
 -- | Put a piece of data with an initialised `UserData` field. This
 -- is necessary if you want to serialise Names or FastStrings.
 -- It also writes a symbol table and the dictionary.
 -- This segment should be read using `getWithUserData`.
-putWithUserData :: Binary a => (SDoc -> IO ()) -> BinHandle -> a -> IO ()
-putWithUserData log_action bh payload = do
+putWithUserData :: Binary a => (SDoc -> Put ()) -> a -> Put ()
+putWithUserData log_action payload = do
     -- Remember where the dictionary pointer will go
-    dict_p_p <- tellBin bh
+    dict_p_p <- tellP
     -- Placeholder for ptr to dictionary
-    put_ bh dict_p_p
+    put dict_p_p
 
     -- Remember where the symbol table pointer will go
-    symtab_p_p <- tellBin bh
-    put_ bh symtab_p_p
+    symtab_p_p <- tellP
+    put symtab_p_p
     -- Make some initial state
-    symtab_next <- newFastMutInt
-    writeFastMutInt symtab_next 0
-    symtab_map <- newIORef emptyUFM
+    symtab_next <- ioP $ newFastMutInt
+    ioP $ writeFastMutInt symtab_next 0
+    symtab_map <- ioP $ newIORef emptyUFM
     let bin_symtab = BinSymbolTable {
                          bin_symtab_next = symtab_next,
                          bin_symtab_map  = symtab_map }
-    dict_next_ref <- newFastMutInt
-    writeFastMutInt dict_next_ref 0
-    dict_map_ref <- newIORef emptyUFM
+    dict_next_ref <- ioP $ newFastMutInt
+    ioP $ writeFastMutInt dict_next_ref 0
+    dict_map_ref <- ioP $ newIORef emptyUFM
     let bin_dict = BinDictionary {
                        bin_dict_next = dict_next_ref,
                        bin_dict_map  = dict_map_ref }
 
     -- Put the main thing,
-    bh <- return $ setUserData bh $ newWriteState (putName bin_dict bin_symtab)
-                                                  (putName bin_dict bin_symtab)
-                                                  (putFastString bin_dict)
-    put_ bh payload
-
-    -- Write the symtab pointer at the front of the file
-    symtab_p <- tellBin bh        -- This is where the symtab will start
-    putAt bh symtab_p_p symtab_p  -- Fill in the placeholder
-    seekBin bh symtab_p           -- Seek back to the end of the file
-
-    -- Write the symbol table itself
-    symtab_next <- readFastMutInt symtab_next
-    symtab_map  <- readIORef symtab_map
-    putSymbolTable bh symtab_next symtab_map
-    log_action (text "writeBinIface:" <+> int symtab_next
-                                <+> text "Names")
-
-    -- NB. write the dictionary after the symbol table, because
-    -- writing the symbol table may create more dictionary entries.
-
-    -- Write the dictionary pointer at the front of the file
-    dict_p <- tellBin bh          -- This is where the dictionary will start
-    putAt bh dict_p_p dict_p      -- Fill in the placeholder
-    seekBin bh dict_p             -- Seek back to the end of the file
-
-    -- Write the dictionary itself
-    dict_next <- readFastMutInt dict_next_ref
-    dict_map  <- readIORef dict_map_ref
-    putDictionary bh dict_next dict_map
-    log_action (text "writeBinIface:" <+> int dict_next
-                                <+> text "dict entries")
-
-
+    writeState (putName bin_dict bin_symtab)
+               (putName bin_dict bin_symtab)
+               (putFastString bin_dict) $ do
+      put payload
+
+      -- Write the symtab pointer at the front of the file
+      symtab_p <- tellP             -- This is where the symtab will start
+      putAt symtab_p_p symtab_p     -- Fill in the placeholder
+      seekP symtab_p           -- Seek back to the end of the file
+
+      -- Write the symbol table itself
+      symtab_next <- ioP $ readFastMutInt symtab_next
+      symtab_map  <- ioP $ readIORef symtab_map
+      putSymbolTable symtab_next symtab_map
+      log_action (text "writeBinIface:" <+> int symtab_next
+                                        <+> text "Names")
+
+      -- NB. write the dictionary after the symbol table, because
+      -- writing the symbol table may create more dictionary entries.
+
+      -- Write the dictionary pointer at the front of the file
+      dict_p <- tellP               -- This is where the dictionary will start
+      putAt dict_p_p dict_p         -- Fill in the placeholder
+      seekP dict_p                  -- Seek back to the end of the file
+
+      -- Write the dictionary itself
+      dict_next <- ioP $ readFastMutInt dict_next_ref
+      dict_map  <- ioP $ readIORef dict_map_ref
+      putDictionary dict_next dict_map
+      log_action (text "writeBinIface:" <+> int dict_next
+                                        <+> text "dict entries")
 
--- | Initial ram buffer to allocate for writing interface files
-initBinMemSize :: Int
-initBinMemSize = 1024 * 1024
 
 binaryInterfaceMagic :: DynFlags -> Word32
 binaryInterfaceMagic dflags
@@ -282,19 +275,19 @@ binaryInterfaceMagic dflags
 -- The symbol table
 --
 
-putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
-putSymbolTable bh next_off symtab = do
-    put_ bh next_off
+putSymbolTable :: Int -> UniqFM (Int,Name) -> Put ()
+putSymbolTable next_off symtab = do
+    put next_off
     let names = elems (array (0,next_off-1) (nonDetEltsUFM symtab))
       -- It's OK to use nonDetEltsUFM here because the elements have
       -- indices that array uses to create order
-    mapM_ (\n -> serialiseName bh n symtab) names
+    mapM_ (\n -> serialiseName n symtab) names
 
-getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
-getSymbolTable bh ncu = do
-    sz <- get bh
-    od_names <- sequence (replicate sz (get bh))
-    updateNameCache ncu $ \namecache ->
+getSymbolTable :: NameCacheUpdater -> Get SymbolTable
+getSymbolTable ncu = do
+    sz <- get
+    od_names <- sequence (replicate sz get)
+    ioG $ updateNameCache ncu $ \namecache ->
         runST $ flip State.evalStateT namecache $ do
             mut_arr <- lift $ newSTArray_ (0, sz-1)
             for_ (zip [0..] od_names) $ \(i, odn) -> do
@@ -323,10 +316,10 @@ fromOnDiskName nc (pid, mod_name, occ) =
                    new_cache  = extendNameCache cache mod occ name
                in ( nc{ nsUniqs = us, nsNames = new_cache }, name )
 
-serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
-serialiseName bh name _ = do
+serialiseName :: Name -> UniqFM (Int,Name) -> Put ()
+serialiseName name _ = do
     let mod = ASSERT2( isExternalName name, ppr name ) nameModule name
-    put_ bh (moduleUnitId mod, moduleName mod, nameOccName name)
+    put (moduleUnitId mod, moduleName mod, nameOccName name)
 
 
 -- Note [Symbol table representation of names]
@@ -347,36 +340,36 @@ serialiseName bh name _ = do
 
 
 -- See Note [Symbol table representation of names]
-putName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
+putName :: BinDictionary -> BinSymbolTable -> Name -> Put ()
 putName _dict BinSymbolTable{
                bin_symtab_map = symtab_map_ref,
                bin_symtab_next = symtab_next }
-        bh name
+        name
   | isKnownKeyName name
   , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
   = -- ASSERT(u < 2^(22 :: Int))
-    put_ bh (0x80000000
-             .|. (fromIntegral (ord c) `shiftL` 22)
-             .|. (fromIntegral u :: Word32))
+    put (0x80000000
+         .|. (fromIntegral (ord c) `shiftL` 22)
+         .|. (fromIntegral u :: Word32))
 
   | otherwise
-  = do symtab_map <- readIORef symtab_map_ref
+  = do symtab_map <- ioP $ readIORef symtab_map_ref
        case lookupUFM symtab_map name of
-         Just (off,_) -> put_ bh (fromIntegral off :: Word32)
+         Just (off,_) -> put (fromIntegral off :: Word32)
          Nothing -> do
-            off <- readFastMutInt symtab_next
+            off <- ioP $ readFastMutInt symtab_next
             -- MASSERT(off < 2^(30 :: Int))
-            writeFastMutInt symtab_next (off+1)
-            writeIORef symtab_map_ref
+            ioP $ writeFastMutInt symtab_next (off+1)
+            ioP $ writeIORef symtab_map_ref
                 $! addToUFM symtab_map name (off,name)
-            put_ bh (fromIntegral off :: Word32)
+            put (fromIntegral off :: Word32)
 
 -- See Note [Symbol table representation of names]
 getSymtabName :: NameCacheUpdater
               -> Dictionary -> SymbolTable
-              -> BinHandle -> IO Name
-getSymtabName _ncu _dict symtab bh = do
-    i :: Word32 <- get bh
+              -> Get Name
+getSymtabName _ncu _dict symtab = do
+    i :: Word32 <- get
     case i .&. 0xC0000000 of
       0x00000000 -> return $! symtab ! fromIntegral i
 
@@ -399,8 +392,8 @@ data BinSymbolTable = BinSymbolTable {
                                 -- indexed by Name
   }
 
-putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
-putFastString dict bh fs = allocateFastString dict fs >>= put_ bh
+putFastString :: BinDictionary -> FastString -> Put ()
+putFastString dict fs = ioP (allocateFastString dict fs) >>= put
 
 allocateFastString :: BinDictionary -> FastString -> IO Word32
 allocateFastString BinDictionary { bin_dict_next = j_r,
@@ -415,9 +408,9 @@ allocateFastString BinDictionary { bin_dict_next = j_r,
            writeIORef out_r $! addToUFM out uniq (j, f)
            return (fromIntegral j :: Word32)
 
-getDictFastString :: Dictionary -> BinHandle -> IO FastString
-getDictFastString dict bh = do
-    j <- get bh
+getDictFastString :: Dictionary -> Get FastString
+getDictFastString dict = do
+    j <- get
     return $! (dict ! fromIntegral (j :: Word32))
 
 data BinDictionary = BinDictionary {
diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs
index 92caee658b..fcd9ecb905 100644
--- a/compiler/iface/FlagChecker.hs
+++ b/compiler/iface/FlagChecker.hs
@@ -30,7 +30,7 @@ import System.FilePath (normalise)
 -- *interface* file, not the actual 'Module' according to our
 -- 'DynFlags'.
 fingerprintDynFlags :: DynFlags -> Module
-                    -> (BinHandle -> Name -> IO ())
+                    -> (Name -> Put ())
                     -> IO Fingerprint
 
 fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
@@ -72,8 +72,8 @@ fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
 -- object files as they can.
 -- See Note [Ignoring some flag changes]
 fingerprintOptFlags :: DynFlags
-                      -> (BinHandle -> Name -> IO ())
-                      -> IO Fingerprint
+                    -> (Name -> Put ())
+                    -> IO Fingerprint
 fingerprintOptFlags DynFlags{..} nameio =
       let
         -- See https://gitlab.haskell.org/ghc/ghc/issues/10923
@@ -90,8 +90,8 @@ fingerprintOptFlags DynFlags{..} nameio =
 -- file compiled for HPC when not actually using HPC.
 -- See Note [Ignoring some flag changes]
 fingerprintHpcFlags :: DynFlags
-                      -> (BinHandle -> Name -> IO ())
-                      -> IO Fingerprint
+                    -> (Name -> Put ())
+                    -> IO Fingerprint
 fingerprintHpcFlags dflags@DynFlags{..} nameio =
       let
         -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index f691300157..1482c689cb 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -100,15 +100,11 @@ type IfaceTopBndr = Name
   -- We don't serialise the namespace onto the disk though; rather we
   -- drop it when serialising and add it back in when deserialising.
 
-getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
-getIfaceTopBndr bh = get bh
+getIfaceTopBndr :: Get IfaceTopBndr
+getIfaceTopBndr = get
 
-putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
-putIfaceTopBndr bh name =
-    case getUserData bh of
-      UserData{ ud_put_binding_name = put_binding_name } ->
-          --pprTrace "putIfaceTopBndr" (ppr name) $
-          put_binding_name bh name
+putIfaceTopBndr :: IfaceTopBndr -> Put ()
+putIfaceTopBndr = putBindingName
 
 data IfaceDecl
   = IfaceId { ifName      :: IfaceTopBndr,
@@ -1766,43 +1762,43 @@ details.
 -}
 
 instance Binary IfaceDecl where
-    put_ bh (IfaceId name ty details idinfo) = do
-        putByte bh 0
-        putIfaceTopBndr bh name
-        lazyPut bh (ty, details, idinfo)
+    put (IfaceId name ty details idinfo) = do
+        putByte 0
+        putIfaceTopBndr name
+        lazyPut (ty, details, idinfo)
         -- See Note [Lazy deserialization of IfaceId]
 
-    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
-        putByte bh 2
-        putIfaceTopBndr bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-
-    put_ bh (IfaceSynonym a1 a2 a3 a4 a5) = do
-        putByte bh 3
-        putIfaceTopBndr bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-
-    put_ bh (IfaceFamily a1 a2 a3 a4 a5 a6) = do
-        putByte bh 4
-        putIfaceTopBndr bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
+    put (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
+        putByte 2
+        putIfaceTopBndr a1
+        put a2
+        put a3
+        put a4
+        put a5
+        put a6
+        put a7
+        put a8
+        put a9
+
+    put (IfaceSynonym a1 a2 a3 a4 a5) = do
+        putByte 3
+        putIfaceTopBndr a1
+        put a2
+        put a3
+        put a4
+        put a5
+
+    put (IfaceFamily a1 a2 a3 a4 a5 a6) = do
+        putByte 4
+        putIfaceTopBndr a1
+        put a2
+        put a3
+        put a4
+        put a5
+        put a6
 
     -- NB: Written in a funny way to avoid an interface change
-    put_ bh (IfaceClass {
+    put (IfaceClass {
                 ifName    = a2,
                 ifRoles   = a3,
                 ifBinders = a4,
@@ -1813,88 +1809,88 @@ instance Binary IfaceDecl where
                     ifSigs = a7,
                     ifMinDef  = a8
                 }}) = do
-        putByte bh 5
-        put_ bh a1
-        putIfaceTopBndr bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-
-    put_ bh (IfaceAxiom a1 a2 a3 a4) = do
-        putByte bh 6
-        putIfaceTopBndr bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-
-    put_ bh (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
-        putByte bh 7
-        putIfaceTopBndr bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-        put_ bh a10
-        put_ bh a11
-
-    put_ bh (IfaceClass {
+        putByte 5
+        put a1
+        putIfaceTopBndr a2
+        put a3
+        put a4
+        put a5
+        put a6
+        put a7
+        put a8
+
+    put (IfaceAxiom a1 a2 a3 a4) = do
+        putByte 6
+        putIfaceTopBndr a1
+        put a2
+        put a3
+        put a4
+
+    put (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
+        putByte 7
+        putIfaceTopBndr a1
+        put a2
+        put a3
+        put a4
+        put a5
+        put a6
+        put a7
+        put a8
+        put a9
+        put a10
+        put a11
+
+    put (IfaceClass {
                 ifName    = a1,
                 ifRoles   = a2,
                 ifBinders = a3,
                 ifFDs     = a4,
                 ifBody = IfAbstractClass }) = do
-        putByte bh 8
-        putIfaceTopBndr bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-
-    get bh = do
-        h <- getByte bh
+        putByte 8
+        putIfaceTopBndr a1
+        put a2
+        put a3
+        put a4
+
+    get = do
+        h <- getByte
         case h of
-            0 -> do name    <- get bh
-                    ~(ty, details, idinfo) <- lazyGet bh
+            0 -> do name <- get
+                    ~(ty, details, idinfo) <- lazyGet
                     -- See Note [Lazy deserialization of IfaceId]
                     return (IfaceId name ty details idinfo)
             1 -> error "Binary.get(TyClDecl): ForeignType"
-            2 -> do a1  <- getIfaceTopBndr bh
-                    a2  <- get bh
-                    a3  <- get bh
-                    a4  <- get bh
-                    a5  <- get bh
-                    a6  <- get bh
-                    a7  <- get bh
-                    a8  <- get bh
-                    a9  <- get bh
+            2 -> do a1  <- getIfaceTopBndr
+                    a2  <- get
+                    a3  <- get
+                    a4  <- get
+                    a5  <- get
+                    a6  <- get
+                    a7  <- get
+                    a8  <- get
+                    a9  <- get
                     return (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9)
-            3 -> do a1 <- getIfaceTopBndr bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
+            3 -> do a1 <- getIfaceTopBndr
+                    a2 <- get
+                    a3 <- get
+                    a4 <- get
+                    a5 <- get
                     return (IfaceSynonym a1 a2 a3 a4 a5)
-            4 -> do a1 <- getIfaceTopBndr bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    a6 <- get bh
+            4 -> do a1 <- getIfaceTopBndr
+                    a2 <- get
+                    a3 <- get
+                    a4 <- get
+                    a5 <- get
+                    a6 <- get
                     return (IfaceFamily a1 a2 a3 a4 a5 a6)
-            5 -> do a1 <- get bh
-                    a2 <- getIfaceTopBndr bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    a6 <- get bh
-                    a7 <- get bh
-                    a8 <- get bh
+            5 -> do a1 <- get
+                    a2 <- getIfaceTopBndr
+                    a3 <- get
+                    a4 <- get
+                    a5 <- get
+                    a6 <- get
+                    a7 <- get
+                    a8 <- get
                     return (IfaceClass {
                         ifName    = a2,
                         ifRoles   = a3,
@@ -1904,29 +1900,29 @@ instance Binary IfaceDecl where
                             ifClassCtxt = a1,
                             ifATs  = a6,
                             ifSigs = a7,
-                            ifMinDef  = a8
+                            ifMinDef = a8
                         }})
-            6 -> do a1 <- getIfaceTopBndr bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
+            6 -> do a1 <- getIfaceTopBndr
+                    a2 <- get
+                    a3 <- get
+                    a4 <- get
                     return (IfaceAxiom a1 a2 a3 a4)
-            7 -> do a1 <- getIfaceTopBndr bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    a6 <- get bh
-                    a7 <- get bh
-                    a8 <- get bh
-                    a9 <- get bh
-                    a10 <- get bh
-                    a11 <- get bh
+            7 -> do a1 <- getIfaceTopBndr
+                    a2 <- get
+                    a3 <- get
+                    a4 <- get
+                    a5 <- get
+                    a6 <- get
+                    a7 <- get
+                    a8 <- get
+                    a9 <- get
+                    a10 <- get
+                    a11 <- get
                     return (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
-            8 -> do a1 <- getIfaceTopBndr bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
+            8 -> do a1 <- getIfaceTopBndr
+                    a2 <- get
+                    a3 <- get
+                    a4 <- get
                     return (IfaceClass {
                         ifName    = a1,
                         ifRoles   = a2,
@@ -1961,462 +1957,462 @@ represent a small proportion of all declarations.
 -}
 
 instance Binary IfaceFamTyConFlav where
-    put_ bh IfaceDataFamilyTyCon              = putByte bh 0
-    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 1
-    put_ bh (IfaceClosedSynFamilyTyCon mb)    = putByte bh 2 >> put_ bh mb
-    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 3
-    put_ _ IfaceBuiltInSynFamTyCon
+    put IfaceDataFamilyTyCon              = putByte 0
+    put IfaceOpenSynFamilyTyCon           = putByte 1
+    put (IfaceClosedSynFamilyTyCon mb)    = putByte 2 >> put mb
+    put IfaceAbstractClosedSynFamilyTyCon = putByte 3
+    put IfaceBuiltInSynFamTyCon
         = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" Outputable.empty
 
-    get bh = do { h <- getByte bh
-                ; case h of
-                    0 -> return IfaceDataFamilyTyCon
-                    1 -> return IfaceOpenSynFamilyTyCon
-                    2 -> do { mb <- get bh
-                            ; return (IfaceClosedSynFamilyTyCon mb) }
-                    3 -> return IfaceAbstractClosedSynFamilyTyCon
-                    _ -> pprPanic "Binary.get(IfaceFamTyConFlav): Invalid tag"
-                                  (ppr (fromIntegral h :: Int)) }
+    get = do { h <- getByte
+             ; case h of
+                 0 -> return IfaceDataFamilyTyCon
+                 1 -> return IfaceOpenSynFamilyTyCon
+                 2 -> do { mb <- get
+                         ; return (IfaceClosedSynFamilyTyCon mb) }
+                 3 -> return IfaceAbstractClosedSynFamilyTyCon
+                 _ -> pprPanic "Binary.get(IfaceFamTyConFlav): Invalid tag"
+                               (ppr (fromIntegral h :: Int)) }
 
 instance Binary IfaceClassOp where
-    put_ bh (IfaceClassOp n ty def) = do
-        putIfaceTopBndr bh n
-        put_ bh ty
-        put_ bh def
-    get bh = do
-        n   <- getIfaceTopBndr bh
-        ty  <- get bh
-        def <- get bh
+    put (IfaceClassOp n ty def) = do
+        putIfaceTopBndr n
+        put ty
+        put def
+    get = do
+        n   <- getIfaceTopBndr
+        ty  <- get
+        def <- get
         return (IfaceClassOp n ty def)
 
 instance Binary IfaceAT where
-    put_ bh (IfaceAT dec defs) = do
-        put_ bh dec
-        put_ bh defs
-    get bh = do
-        dec  <- get bh
-        defs <- get bh
+    put (IfaceAT dec defs) = do
+        put dec
+        put defs
+    get = do
+        dec  <- get
+        defs <- get
         return (IfaceAT dec defs)
 
 instance Binary IfaceAxBranch where
-    put_ bh (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        a6 <- get bh
-        a7 <- get bh
+    put (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7) = do
+        put a1
+        put a2
+        put a3
+        put a4
+        put a5
+        put a6
+        put a7
+    get = do
+        a1 <- get
+        a2 <- get
+        a3 <- get
+        a4 <- get
+        a5 <- get
+        a6 <- get
+        a7 <- get
         return (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7)
 
 instance Binary IfaceConDecls where
-    put_ bh IfAbstractTyCon  = putByte bh 0
-    put_ bh (IfDataTyCon cs) = putByte bh 1 >> put_ bh cs
-    put_ bh (IfNewTyCon c)   = putByte bh 2 >> put_ bh c
-    get bh = do
-        h <- getByte bh
+    put IfAbstractTyCon  = putByte 0
+    put (IfDataTyCon cs) = putByte 1 >> put cs
+    put (IfNewTyCon c)   = putByte 2 >> put c
+    get = do
+        h <- getByte
         case h of
             0 -> return IfAbstractTyCon
-            1 -> liftM IfDataTyCon (get bh)
-            2 -> liftM IfNewTyCon (get bh)
+            1 -> liftM IfDataTyCon get
+            2 -> liftM IfNewTyCon get
             _ -> error "Binary(IfaceConDecls).get: Invalid IfaceConDecls"
 
 instance Binary IfaceConDecl where
-    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
-        putIfaceTopBndr bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh (length a9)
-        mapM_ (put_ bh) a9
-        put_ bh a10
-        put_ bh a11
-    get bh = do
-        a1 <- getIfaceTopBndr bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        a6 <- get bh
-        a7 <- get bh
-        a8 <- get bh
-        n_fields <- get bh
-        a9 <- replicateM n_fields (get bh)
-        a10 <- get bh
-        a11 <- get bh
+    put (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
+        putIfaceTopBndr a1
+        put a2
+        put a3
+        put a4
+        put a5
+        put a6
+        put a7
+        put a8
+        put (length a9)
+        mapM_ put a9
+        put a10
+        put a11
+    get = do
+        a1 <- getIfaceTopBndr
+        a2 <- get
+        a3 <- get
+        a4 <- get
+        a5 <- get
+        a6 <- get
+        a7 <- get
+        a8 <- get
+        n_fields <- get
+        a9 <- replicateM n_fields get
+        a10 <- get
+        a11 <- get
         return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
 
 instance Binary IfaceBang where
-    put_ bh IfNoBang        = putByte bh 0
-    put_ bh IfStrict        = putByte bh 1
-    put_ bh IfUnpack        = putByte bh 2
-    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
+    put IfNoBang        = putByte 0
+    put IfStrict        = putByte 1
+    put IfUnpack        = putByte 2
+    put (IfUnpackCo co) = putByte 3 >> put co
 
-    get bh = do
-            h <- getByte bh
+    get = do
+            h <- getByte
             case h of
               0 -> do return IfNoBang
               1 -> do return IfStrict
               2 -> do return IfUnpack
-              _ -> do { a <- get bh; return (IfUnpackCo a) }
+              _ -> do { a <- get; return (IfUnpackCo a) }
 
 instance Binary IfaceSrcBang where
-    put_ bh (IfSrcBang a1 a2) =
-      do put_ bh a1
-         put_ bh a2
+    put (IfSrcBang a1 a2) =
+      do put a1
+         put a2
 
-    get bh =
-      do a1 <- get bh
-         a2 <- get bh
+    get =
+      do a1 <- get
+         a2 <- get
          return (IfSrcBang a1 a2)
 
 instance Binary IfaceClsInst where
-    put_ bh (IfaceClsInst cls tys dfun flag orph) = do
-        put_ bh cls
-        put_ bh tys
-        put_ bh dfun
-        put_ bh flag
-        put_ bh orph
-    get bh = do
-        cls  <- get bh
-        tys  <- get bh
-        dfun <- get bh
-        flag <- get bh
-        orph <- get bh
+    put (IfaceClsInst cls tys dfun flag orph) = do
+        put cls
+        put tys
+        put dfun
+        put flag
+        put orph
+    get = do
+        cls  <- get
+        tys  <- get
+        dfun <- get
+        flag <- get
+        orph <- get
         return (IfaceClsInst cls tys dfun flag orph)
 
 instance Binary IfaceFamInst where
-    put_ bh (IfaceFamInst fam tys name orph) = do
-        put_ bh fam
-        put_ bh tys
-        put_ bh name
-        put_ bh orph
-    get bh = do
-        fam      <- get bh
-        tys      <- get bh
-        name     <- get bh
-        orph     <- get bh
+    put (IfaceFamInst fam tys name orph) = do
+        put fam
+        put tys
+        put name
+        put orph
+    get = do
+        fam  <- get
+        tys  <- get
+        name <- get
+        orph <- get
         return (IfaceFamInst fam tys name orph)
 
 instance Binary IfaceRule where
-    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        a6 <- get bh
-        a7 <- get bh
-        a8 <- get bh
+    put (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
+        put a1
+        put a2
+        put a3
+        put a4
+        put a5
+        put a6
+        put a7
+        put a8
+    get = do
+        a1 <- get
+        a2 <- get
+        a3 <- get
+        a4 <- get
+        a5 <- get
+        a6 <- get
+        a7 <- get
+        a8 <- get
         return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)
 
 instance Binary IfaceAnnotation where
-    put_ bh (IfaceAnnotation a1 a2) = do
-        put_ bh a1
-        put_ bh a2
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
+    put (IfaceAnnotation a1 a2) = do
+        put a1
+        put a2
+    get = do
+        a1 <- get
+        a2 <- get
         return (IfaceAnnotation a1 a2)
 
 instance Binary IfaceIdDetails where
-    put_ bh IfVanillaId      = putByte bh 0
-    put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
-    put_ bh IfDFunId         = putByte bh 2
-    get bh = do
-        h <- getByte bh
+    put IfVanillaId      = putByte 0
+    put (IfRecSelId a b) = putByte 1 >> put a >> put b
+    put IfDFunId         = putByte 2
+    get = do
+        h <- getByte
         case h of
             0 -> return IfVanillaId
-            1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
+            1 -> do { a <- get; b <- get; return (IfRecSelId a b) }
             _ -> return IfDFunId
 
 instance Binary IfaceIdInfo where
-    put_ bh NoInfo      = putByte bh 0
-    put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
+    put NoInfo      = putByte 0
+    put (HasInfo i) = putByte 1 >> lazyPut i -- NB lazyPut
 
-    get bh = do
-        h <- getByte bh
+    get = do
+        h <- getByte
         case h of
             0 -> return NoInfo
-            _ -> liftM HasInfo $ lazyGet bh    -- NB lazyGet
+            _ -> liftM HasInfo $ lazyGet     -- NB lazyGet
 
 instance Binary IfaceInfoItem where
-    put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa
-    put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab
-    put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad
-    put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad
-    put_ bh HsNoCafRefs           = putByte bh 4
-    put_ bh HsLevity              = putByte bh 5
-    get bh = do
-        h <- getByte bh
+    put (HsArity aa)          = putByte 0 >> put aa
+    put (HsStrictness ab)     = putByte 1 >> put ab
+    put (HsUnfold lb ad)      = putByte 2 >> put lb >> put ad
+    put (HsInline ad)         = putByte 3 >> put ad
+    put HsNoCafRefs           = putByte 4
+    put HsLevity              = putByte 5
+    get = do
+        h <- getByte
         case h of
-            0 -> liftM HsArity $ get bh
-            1 -> liftM HsStrictness $ get bh
-            2 -> do lb <- get bh
-                    ad <- get bh
+            0 -> liftM HsArity $ get
+            1 -> liftM HsStrictness $ get
+            2 -> do lb <- get
+                    ad <- get
                     return (HsUnfold lb ad)
-            3 -> liftM HsInline $ get bh
+            3 -> liftM HsInline $ get
             4 -> return HsNoCafRefs
             _ -> return HsLevity
 
 instance Binary IfaceUnfolding where
-    put_ bh (IfCoreUnfold s e) = do
-        putByte bh 0
-        put_ bh s
-        put_ bh e
-    put_ bh (IfInlineRule a b c d) = do
-        putByte bh 1
-        put_ bh a
-        put_ bh b
-        put_ bh c
-        put_ bh d
-    put_ bh (IfDFunUnfold as bs) = do
-        putByte bh 2
-        put_ bh as
-        put_ bh bs
-    put_ bh (IfCompulsory e) = do
-        putByte bh 3
-        put_ bh e
-    get bh = do
-        h <- getByte bh
+    put (IfCoreUnfold s e) = do
+        putByte 0
+        put s
+        put e
+    put (IfInlineRule a b c d) = do
+        putByte 1
+        put a
+        put b
+        put c
+        put d
+    put (IfDFunUnfold as bs) = do
+        putByte 2
+        put as
+        put bs
+    put (IfCompulsory e) = do
+        putByte 3
+        put e
+    get = do
+        h <- getByte
         case h of
-            0 -> do s <- get bh
-                    e <- get bh
+            0 -> do s <- get
+                    e <- get
                     return (IfCoreUnfold s e)
-            1 -> do a <- get bh
-                    b <- get bh
-                    c <- get bh
-                    d <- get bh
+            1 -> do a <- get
+                    b <- get
+                    c <- get
+                    d <- get
                     return (IfInlineRule a b c d)
-            2 -> do as <- get bh
-                    bs <- get bh
+            2 -> do as <- get
+                    bs <- get
                     return (IfDFunUnfold as bs)
-            _ -> do e <- get bh
+            _ -> do e <- get
                     return (IfCompulsory e)
 
 
 instance Binary IfaceExpr where
-    put_ bh (IfaceLcl aa) = do
-        putByte bh 0
-        put_ bh aa
-    put_ bh (IfaceType ab) = do
-        putByte bh 1
-        put_ bh ab
-    put_ bh (IfaceCo ab) = do
-        putByte bh 2
-        put_ bh ab
-    put_ bh (IfaceTuple ac ad) = do
-        putByte bh 3
-        put_ bh ac
-        put_ bh ad
-    put_ bh (IfaceLam (ae, os) af) = do
-        putByte bh 4
-        put_ bh ae
-        put_ bh os
-        put_ bh af
-    put_ bh (IfaceApp ag ah) = do
-        putByte bh 5
-        put_ bh ag
-        put_ bh ah
-    put_ bh (IfaceCase ai aj ak) = do
-        putByte bh 6
-        put_ bh ai
-        put_ bh aj
-        put_ bh ak
-    put_ bh (IfaceLet al am) = do
-        putByte bh 7
-        put_ bh al
-        put_ bh am
-    put_ bh (IfaceTick an ao) = do
-        putByte bh 8
-        put_ bh an
-        put_ bh ao
-    put_ bh (IfaceLit ap) = do
-        putByte bh 9
-        put_ bh ap
-    put_ bh (IfaceFCall as at) = do
-        putByte bh 10
-        put_ bh as
-        put_ bh at
-    put_ bh (IfaceExt aa) = do
-        putByte bh 11
-        put_ bh aa
-    put_ bh (IfaceCast ie ico) = do
-        putByte bh 12
-        put_ bh ie
-        put_ bh ico
-    put_ bh (IfaceECase a b) = do
-        putByte bh 13
-        put_ bh a
-        put_ bh b
-    get bh = do
-        h <- getByte bh
+    put (IfaceLcl aa) = do
+        putByte 0
+        put aa
+    put (IfaceType ab) = do
+        putByte 1
+        put ab
+    put (IfaceCo ab) = do
+        putByte 2
+        put ab
+    put (IfaceTuple ac ad) = do
+        putByte 3
+        put ac
+        put ad
+    put (IfaceLam (ae, os) af) = do
+        putByte 4
+        put ae
+        put os
+        put af
+    put (IfaceApp ag ah) = do
+        putByte 5
+        put ag
+        put ah
+    put (IfaceCase ai aj ak) = do
+        putByte 6
+        put ai
+        put aj
+        put ak
+    put (IfaceLet al am) = do
+        putByte 7
+        put al
+        put am
+    put (IfaceTick an ao) = do
+        putByte 8
+        put an
+        put ao
+    put (IfaceLit ap) = do
+        putByte 9
+        put ap
+    put (IfaceFCall as at) = do
+        putByte 10
+        put as
+        put at
+    put (IfaceExt aa) = do
+        putByte 11
+        put aa
+    put (IfaceCast ie ico) = do
+        putByte 12
+        put ie
+        put ico
+    put (IfaceECase a b) = do
+        putByte 13
+        put a
+        put b
+    get = do
+        h <- getByte
         case h of
-            0 -> do aa <- get bh
+            0 -> do aa <- get
                     return (IfaceLcl aa)
-            1 -> do ab <- get bh
+            1 -> do ab <- get
                     return (IfaceType ab)
-            2 -> do ab <- get bh
+            2 -> do ab <- get
                     return (IfaceCo ab)
-            3 -> do ac <- get bh
-                    ad <- get bh
+            3 -> do ac <- get
+                    ad <- get
                     return (IfaceTuple ac ad)
-            4 -> do ae <- get bh
-                    os <- get bh
-                    af <- get bh
+            4 -> do ae <- get
+                    os <- get
+                    af <- get
                     return (IfaceLam (ae, os) af)
-            5 -> do ag <- get bh
-                    ah <- get bh
+            5 -> do ag <- get
+                    ah <- get
                     return (IfaceApp ag ah)
-            6 -> do ai <- get bh
-                    aj <- get bh
-                    ak <- get bh
+            6 -> do ai <- get
+                    aj <- get
+                    ak <- get
                     return (IfaceCase ai aj ak)
-            7 -> do al <- get bh
-                    am <- get bh
+            7 -> do al <- get
+                    am <- get
                     return (IfaceLet al am)
-            8 -> do an <- get bh
-                    ao <- get bh
+            8 -> do an <- get
+                    ao <- get
                     return (IfaceTick an ao)
-            9 -> do ap <- get bh
+            9 -> do ap <- get
                     return (IfaceLit ap)
-            10 -> do as <- get bh
-                     at <- get bh
+            10 -> do as <- get
+                     at <- get
                      return (IfaceFCall as at)
-            11 -> do aa <- get bh
+            11 -> do aa <- get
                      return (IfaceExt aa)
-            12 -> do ie <- get bh
-                     ico <- get bh
+            12 -> do ie <- get
+                     ico <- get
                      return (IfaceCast ie ico)
-            13 -> do a <- get bh
-                     b <- get bh
+            13 -> do a <- get
+                     b <- get
                      return (IfaceECase a b)
             _ -> panic ("get IfaceExpr " ++ show h)
 
 instance Binary IfaceTickish where
-    put_ bh (IfaceHpcTick m ix) = do
-        putByte bh 0
-        put_ bh m
-        put_ bh ix
-    put_ bh (IfaceSCC cc tick push) = do
-        putByte bh 1
-        put_ bh cc
-        put_ bh tick
-        put_ bh push
-    put_ bh (IfaceSource src name) = do
-        putByte bh 2
-        put_ bh (srcSpanFile src)
-        put_ bh (srcSpanStartLine src)
-        put_ bh (srcSpanStartCol src)
-        put_ bh (srcSpanEndLine src)
-        put_ bh (srcSpanEndCol src)
-        put_ bh name
-
-    get bh = do
-        h <- getByte bh
+    put (IfaceHpcTick m ix) = do
+        putByte 0
+        put m
+        put ix
+    put (IfaceSCC cc tick push) = do
+        putByte 1
+        put cc
+        put tick
+        put push
+    put (IfaceSource src name) = do
+        putByte 2
+        put (srcSpanFile src)
+        put (srcSpanStartLine src)
+        put (srcSpanStartCol src)
+        put (srcSpanEndLine src)
+        put (srcSpanEndCol src)
+        put name
+
+    get = do
+        h <- getByte
         case h of
-            0 -> do m <- get bh
-                    ix <- get bh
+            0 -> do m <- get
+                    ix <- get
                     return (IfaceHpcTick m ix)
-            1 -> do cc <- get bh
-                    tick <- get bh
-                    push <- get bh
+            1 -> do cc <- get
+                    tick <- get
+                    push <- get
                     return (IfaceSCC cc tick push)
-            2 -> do file <- get bh
-                    sl <- get bh
-                    sc <- get bh
-                    el <- get bh
-                    ec <- get bh
+            2 -> do file <- get
+                    sl <- get
+                    sc <- get
+                    el <- get
+                    ec <- get
                     let start = mkRealSrcLoc file sl sc
                         end = mkRealSrcLoc file el ec
-                    name <- get bh
+                    name <- get
                     return (IfaceSource (mkRealSrcSpan start end) name)
             _ -> panic ("get IfaceTickish " ++ show h)
 
 instance Binary IfaceConAlt where
-    put_ bh IfaceDefault      = putByte bh 0
-    put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa
-    put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac
-    get bh = do
-        h <- getByte bh
+    put IfaceDefault      = putByte 0
+    put (IfaceDataAlt aa) = putByte 1 >> put aa
+    put (IfaceLitAlt ac)  = putByte 2 >> put ac
+    get = do
+        h <- getByte
         case h of
             0 -> return IfaceDefault
-            1 -> liftM IfaceDataAlt $ get bh
-            _ -> liftM IfaceLitAlt  $ get bh
+            1 -> liftM IfaceDataAlt $ get
+            _ -> liftM IfaceLitAlt  $ get
 
 instance Binary IfaceBinding where
-    put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab
-    put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac
-    get bh = do
-        h <- getByte bh
+    put (IfaceNonRec aa ab) = putByte 0 >> put aa >> put ab
+    put (IfaceRec ac)       = putByte 1 >> put ac
+    get = do
+        h <- getByte
         case h of
-            0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }
-            _ -> do { ac <- get bh; return (IfaceRec ac) }
+            0 -> do { aa <- get; ab <- get; return (IfaceNonRec aa ab) }
+            _ -> do { ac <- get; return (IfaceRec ac) }
 
 instance Binary IfaceLetBndr where
-    put_ bh (IfLetBndr a b c d) = do
-            put_ bh a
-            put_ bh b
-            put_ bh c
-            put_ bh d
-    get bh = do a <- get bh
-                b <- get bh
-                c <- get bh
-                d <- get bh
-                return (IfLetBndr a b c d)
+    put (IfLetBndr a b c d) = do
+            put a
+            put b
+            put c
+            put d
+    get = do a <- get
+             b <- get
+             c <- get
+             d <- get
+             return (IfLetBndr a b c d)
 
 instance Binary IfaceJoinInfo where
-    put_ bh IfaceNotJoinPoint = putByte bh 0
-    put_ bh (IfaceJoinPoint ar) = do
-        putByte bh 1
-        put_ bh ar
-    get bh = do
-        h <- getByte bh
+    put IfaceNotJoinPoint = putByte 0
+    put (IfaceJoinPoint ar) = do
+        putByte 1
+        put ar
+    get = do
+        h <- getByte
         case h of
             0 -> return IfaceNotJoinPoint
-            _ -> liftM IfaceJoinPoint $ get bh
+            _ -> liftM IfaceJoinPoint $ get
 
 instance Binary IfaceTyConParent where
-    put_ bh IfNoParent = putByte bh 0
-    put_ bh (IfDataInstance ax pr ty) = do
-        putByte bh 1
-        put_ bh ax
-        put_ bh pr
-        put_ bh ty
-    get bh = do
-        h <- getByte bh
+    put IfNoParent = putByte 0
+    put (IfDataInstance ax pr ty) = do
+        putByte 1
+        put ax
+        put pr
+        put ty
+    get = do
+        h <- getByte
         case h of
             0 -> return IfNoParent
             _ -> do
-                ax <- get bh
-                pr <- get bh
-                ty <- get bh
+                ax <- get
+                pr <- get
+                ty <- get
                 return $ IfDataInstance ax pr ty
 
 instance Binary IfaceCompleteMatch where
-  put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts
-  get bh = IfaceCompleteMatch <$> get bh <*> get bh
+  put (IfaceCompleteMatch cs ts) = put cs >> put ts
+  get = IfaceCompleteMatch <$> get <*> get
 
 
 {-
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 37355a1329..44e8e7088a 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -783,27 +783,23 @@ pprIfaceTyConBinders suppress_sig = sep . map go
         ppr_bndr = pprIfaceTvBndr bndr suppress_sig
 
 instance Binary IfaceBndr where
-    put_ bh (IfaceIdBndr aa) = do
-            putByte bh 0
-            put_ bh aa
-    put_ bh (IfaceTvBndr ab) = do
-            putByte bh 1
-            put_ bh ab
-    get bh = do
-            h <- getByte bh
+    put (IfaceIdBndr aa) = do
+            putByte 0
+            put aa
+    put (IfaceTvBndr ab) = do
+            putByte 1
+            put ab
+    get = do
+            h <- getByte
             case h of
-              0 -> do aa <- get bh
-                      return (IfaceIdBndr aa)
-              _ -> do ab <- get bh
-                      return (IfaceTvBndr ab)
+              0 -> IfaceIdBndr <$> get
+              _ -> IfaceTvBndr <$> get
 
 instance Binary IfaceOneShot where
-    put_ bh IfaceNoOneShot = do
-            putByte bh 0
-    put_ bh IfaceOneShot = do
-            putByte bh 1
-    get bh = do
-            h <- getByte bh
+    put IfaceNoOneShot = putByte 0
+    put IfaceOneShot   = putByte 1
+    get = do
+            h <- getByte
             case h of
               0 -> do return IfaceNoOneShot
               _ -> do return IfaceOneShot
@@ -1627,60 +1623,55 @@ instance Outputable IfaceCoercion where
   ppr = pprIfaceCoercion
 
 instance Binary IfaceTyCon where
-   put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i
-
-   get bh = do n <- get bh
-               i <- get bh
-               return (IfaceTyCon n i)
+   put (IfaceTyCon n i) = put n >> put i
+   get = IfaceTyCon <$> get <*> get
 
 instance Binary IfaceTyConSort where
-   put_ bh IfaceNormalTyCon             = putByte bh 0
-   put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort
-   put_ bh (IfaceSumTyCon arity)        = putByte bh 2 >> put_ bh arity
-   put_ bh IfaceEqualityTyCon           = putByte bh 3
+   put IfaceNormalTyCon             = putByte 0
+   put (IfaceTupleTyCon arity sort) = putByte 1 >> put arity >> put sort
+   put (IfaceSumTyCon arity)        = putByte 2 >> put arity
+   put IfaceEqualityTyCon           = putByte 3
 
-   get bh = do
-       n <- getByte bh
+   get = do
+       n <- getByte
        case n of
          0 -> return IfaceNormalTyCon
-         1 -> IfaceTupleTyCon <$> get bh <*> get bh
-         2 -> IfaceSumTyCon <$> get bh
+         1 -> IfaceTupleTyCon <$> get <*> get
+         2 -> IfaceSumTyCon <$> get
          _ -> return IfaceEqualityTyCon
 
 instance Binary IfaceTyConInfo where
-   put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
+   put (IfaceTyConInfo i s) = put i >> put s
 
-   get bh = IfaceTyConInfo <$> get bh <*> get bh
+   get = IfaceTyConInfo <$> get <*> get
 
 instance Outputable IfaceTyLit where
   ppr = pprIfaceTyLit
 
 instance Binary IfaceTyLit where
-  put_ bh (IfaceNumTyLit n)  = putByte bh 1 >> put_ bh n
-  put_ bh (IfaceStrTyLit n)  = putByte bh 2 >> put_ bh n
+  put (IfaceNumTyLit n) = putByte 1 >> put n
+  put (IfaceStrTyLit n) = putByte 2 >> put n
 
-  get bh =
-    do tag <- getByte bh
+  get =
+    do tag <- getByte
        case tag of
-         1 -> do { n <- get bh
-                 ; return (IfaceNumTyLit n) }
-         2 -> do { n <- get bh
-                 ; return (IfaceStrTyLit n) }
+         1 -> IfaceNumTyLit <$> get
+         2 -> IfaceStrTyLit <$> get
          _ -> panic ("get IfaceTyLit " ++ show tag)
 
 instance Binary IfaceAppArgs where
-  put_ bh tk =
+  put tk =
     case tk of
-      IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts
-      IA_Nil        -> putByte bh 1
+      IA_Arg t a ts -> putByte 0 >> put t >> put a >> put ts
+      IA_Nil        -> putByte 1
 
-  get bh =
-    do c <- getByte bh
+  get =
+    do c <- getByte
        case c of
          0 -> do
-           t  <- get bh
-           a  <- get bh
-           ts <- get bh
+           t  <- get
+           a  <- get
+           ts <- get
            return $! IA_Arg t a ts
          1 -> return IA_Nil
          _ -> panic ("get IfaceAppArgs " ++ show c)
@@ -1738,246 +1729,246 @@ ppr_parend_preds :: [IfacePredType] -> SDoc
 ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))
 
 instance Binary IfaceType where
-    put_ _ (IfaceFreeTyVar tv)
+    put (IfaceFreeTyVar tv)
        = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)
 
-    put_ bh (IfaceForAllTy aa ab) = do
-            putByte bh 0
-            put_ bh aa
-            put_ bh ab
-    put_ bh (IfaceTyVar ad) = do
-            putByte bh 1
-            put_ bh ad
-    put_ bh (IfaceAppTy ae af) = do
-            putByte bh 2
-            put_ bh ae
-            put_ bh af
-    put_ bh (IfaceFunTy af ag ah) = do
-            putByte bh 3
-            put_ bh af
-            put_ bh ag
-            put_ bh ah
-    put_ bh (IfaceTyConApp tc tys)
-      = do { putByte bh 5; put_ bh tc; put_ bh tys }
-    put_ bh (IfaceCastTy a b)
-      = do { putByte bh 6; put_ bh a; put_ bh b }
-    put_ bh (IfaceCoercionTy a)
-      = do { putByte bh 7; put_ bh a }
-    put_ bh (IfaceTupleTy s i tys)
-      = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }
-    put_ bh (IfaceLitTy n)
-      = do { putByte bh 9; put_ bh n }
-
-    get bh = do
-            h <- getByte bh
+    put (IfaceForAllTy aa ab) = do
+            putByte 0
+            put aa
+            put ab
+    put (IfaceTyVar ad) = do
+            putByte 1
+            put ad
+    put (IfaceAppTy ae af) = do
+            putByte 2
+            put ae
+            put af
+    put (IfaceFunTy af ag ah) = do
+            putByte 3
+            put af
+            put ag
+            put ah
+    put (IfaceTyConApp tc tys)
+      = do { putByte 5; put tc; put tys }
+    put (IfaceCastTy a b)
+      = do { putByte 6; put a; put b }
+    put (IfaceCoercionTy a)
+      = do { putByte 7; put a }
+    put (IfaceTupleTy s i tys)
+      = do { putByte 8; put s; put i; put tys }
+    put (IfaceLitTy n)
+      = do { putByte 9; put n }
+
+    get = do
+            h <- getByte
             case h of
-              0 -> do aa <- get bh
-                      ab <- get bh
+              0 -> do aa <- get
+                      ab <- get
                       return (IfaceForAllTy aa ab)
-              1 -> do ad <- get bh
+              1 -> do ad <- get
                       return (IfaceTyVar ad)
-              2 -> do ae <- get bh
-                      af <- get bh
+              2 -> do ae <- get
+                      af <- get
                       return (IfaceAppTy ae af)
-              3 -> do af <- get bh
-                      ag <- get bh
-                      ah <- get bh
+              3 -> do af <- get
+                      ag <- get
+                      ah <- get
                       return (IfaceFunTy af ag ah)
-              5 -> do { tc <- get bh; tys <- get bh
+              5 -> do { tc <- get; tys <- get
                       ; return (IfaceTyConApp tc tys) }
-              6 -> do { a <- get bh; b <- get bh
+              6 -> do { a <- get; b <- get
                       ; return (IfaceCastTy a b) }
-              7 -> do { a <- get bh
+              7 -> do { a <- get
                       ; return (IfaceCoercionTy a) }
 
-              8 -> do { s <- get bh; i <- get bh; tys <- get bh
+              8 -> do { s <- get; i <- get; tys <- get
                       ; return (IfaceTupleTy s i tys) }
-              _  -> do n <- get bh
+              _  -> do n <- get
                        return (IfaceLitTy n)
 
 instance Binary IfaceMCoercion where
-  put_ bh IfaceMRefl = do
-          putByte bh 1
-  put_ bh (IfaceMCo co) = do
-          putByte bh 2
-          put_ bh co
-
-  get bh = do
-    tag <- getByte bh
+  put IfaceMRefl = do
+      putByte 1
+  put (IfaceMCo co) = do
+      putByte 2
+      put co
+
+  get = do
+    tag <- getByte
     case tag of
          1 -> return IfaceMRefl
-         2 -> do a <- get bh
+         2 -> do a <- get
                  return $ IfaceMCo a
          _ -> panic ("get IfaceMCoercion " ++ show tag)
 
 instance Binary IfaceCoercion where
-  put_ bh (IfaceReflCo a) = do
-          putByte bh 1
-          put_ bh a
-  put_ bh (IfaceGReflCo a b c) = do
-          putByte bh 2
-          put_ bh a
-          put_ bh b
-          put_ bh c
-  put_ bh (IfaceFunCo a b c) = do
-          putByte bh 3
-          put_ bh a
-          put_ bh b
-          put_ bh c
-  put_ bh (IfaceTyConAppCo a b c) = do
-          putByte bh 4
-          put_ bh a
-          put_ bh b
-          put_ bh c
-  put_ bh (IfaceAppCo a b) = do
-          putByte bh 5
-          put_ bh a
-          put_ bh b
-  put_ bh (IfaceForAllCo a b c) = do
-          putByte bh 6
-          put_ bh a
-          put_ bh b
-          put_ bh c
-  put_ bh (IfaceCoVarCo a) = do
-          putByte bh 7
-          put_ bh a
-  put_ bh (IfaceAxiomInstCo a b c) = do
-          putByte bh 8
-          put_ bh a
-          put_ bh b
-          put_ bh c
-  put_ bh (IfaceUnivCo a b c d) = do
-          putByte bh 9
-          put_ bh a
-          put_ bh b
-          put_ bh c
-          put_ bh d
-  put_ bh (IfaceSymCo a) = do
-          putByte bh 10
-          put_ bh a
-  put_ bh (IfaceTransCo a b) = do
-          putByte bh 11
-          put_ bh a
-          put_ bh b
-  put_ bh (IfaceNthCo a b) = do
-          putByte bh 12
-          put_ bh a
-          put_ bh b
-  put_ bh (IfaceLRCo a b) = do
-          putByte bh 13
-          put_ bh a
-          put_ bh b
-  put_ bh (IfaceInstCo a b) = do
-          putByte bh 14
-          put_ bh a
-          put_ bh b
-  put_ bh (IfaceKindCo a) = do
-          putByte bh 15
-          put_ bh a
-  put_ bh (IfaceSubCo a) = do
-          putByte bh 16
-          put_ bh a
-  put_ bh (IfaceAxiomRuleCo a b) = do
-          putByte bh 17
-          put_ bh a
-          put_ bh b
-  put_ _ (IfaceFreeCoVar cv)
-       = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
-  put_ _  (IfaceHoleCo cv)
-       = pprPanic "Can't serialise IfaceHoleCo" (ppr cv)
+  put (IfaceReflCo a) = do
+      putByte 1
+      put a
+  put (IfaceGReflCo a b c) = do
+      putByte 2
+      put a
+      put b
+      put c
+  put (IfaceFunCo a b c) = do
+      putByte 3
+      put a
+      put b
+      put c
+  put (IfaceTyConAppCo a b c) = do
+      putByte 4
+      put a
+      put b
+      put c
+  put (IfaceAppCo a b) = do
+      putByte 5
+      put a
+      put b
+  put (IfaceForAllCo a b c) = do
+      putByte 6
+      put a
+      put b
+      put c
+  put (IfaceCoVarCo a) = do
+      putByte 7
+      put a
+  put (IfaceAxiomInstCo a b c) = do
+      putByte 8
+      put a
+      put b
+      put c
+  put (IfaceUnivCo a b c d) = do
+      putByte 9
+      put a
+      put b
+      put c
+      put d
+  put (IfaceSymCo a) = do
+      putByte 10
+      put a
+  put (IfaceTransCo a b) = do
+      putByte 11
+      put a
+      put b
+  put (IfaceNthCo a b) = do
+      putByte 12
+      put a
+      put b
+  put (IfaceLRCo a b) = do
+      putByte 13
+      put a
+      put b
+  put (IfaceInstCo a b) = do
+      putByte 14
+      put a
+      put b
+  put (IfaceKindCo a) = do
+      putByte 15
+      put a
+  put (IfaceSubCo a) = do
+      putByte 16
+      put a
+  put (IfaceAxiomRuleCo a b) = do
+      putByte 17
+      put a
+      put b
+  put (IfaceFreeCoVar cv)
+      = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
+  put (IfaceHoleCo cv)
+      = pprPanic "Can't serialise IfaceHoleCo" (ppr cv)
           -- See Note [Holes in IfaceCoercion]
 
-  get bh = do
-      tag <- getByte bh
+  get = do
+      tag <- getByte
       case tag of
-           1 -> do a <- get bh
+           1 -> do a <- get
                    return $ IfaceReflCo a
-           2 -> do a <- get bh
-                   b <- get bh
-                   c <- get bh
+           2 -> do a <- get
+                   b <- get
+                   c <- get
                    return $ IfaceGReflCo a b c
-           3 -> do a <- get bh
-                   b <- get bh
-                   c <- get bh
+           3 -> do a <- get
+                   b <- get
+                   c <- get
                    return $ IfaceFunCo a b c
-           4 -> do a <- get bh
-                   b <- get bh
-                   c <- get bh
+           4 -> do a <- get
+                   b <- get
+                   c <- get
                    return $ IfaceTyConAppCo a b c
-           5 -> do a <- get bh
-                   b <- get bh
+           5 -> do a <- get
+                   b <- get
                    return $ IfaceAppCo a b
-           6 -> do a <- get bh
-                   b <- get bh
-                   c <- get bh
+           6 -> do a <- get
+                   b <- get
+                   c <- get
                    return $ IfaceForAllCo a b c
-           7 -> do a <- get bh
+           7 -> do a <- get
                    return $ IfaceCoVarCo a
-           8 -> do a <- get bh
-                   b <- get bh
-                   c <- get bh
+           8 -> do a <- get
+                   b <- get
+                   c <- get
                    return $ IfaceAxiomInstCo a b c
-           9 -> do a <- get bh
-                   b <- get bh
-                   c <- get bh
-                   d <- get bh
+           9 -> do a <- get
+                   b <- get
+                   c <- get
+                   d <- get
                    return $ IfaceUnivCo a b c d
-           10-> do a <- get bh
+           10-> do a <- get
                    return $ IfaceSymCo a
-           11-> do a <- get bh
-                   b <- get bh
+           11-> do a <- get
+                   b <- get
                    return $ IfaceTransCo a b
-           12-> do a <- get bh
-                   b <- get bh
+           12-> do a <- get
+                   b <- get
                    return $ IfaceNthCo a b
-           13-> do a <- get bh
-                   b <- get bh
+           13-> do a <- get
+                   b <- get
                    return $ IfaceLRCo a b
-           14-> do a <- get bh
-                   b <- get bh
+           14-> do a <- get
+                   b <- get
                    return $ IfaceInstCo a b
-           15-> do a <- get bh
+           15-> do a <- get
                    return $ IfaceKindCo a
-           16-> do a <- get bh
+           16-> do a <- get
                    return $ IfaceSubCo a
-           17-> do a <- get bh
-                   b <- get bh
+           17-> do a <- get
+                   b <- get
                    return $ IfaceAxiomRuleCo a b
            _ -> panic ("get IfaceCoercion " ++ show tag)
 
 instance Binary IfaceUnivCoProv where
-  put_ bh IfaceUnsafeCoerceProv = putByte bh 1
-  put_ bh (IfacePhantomProv a) = do
-          putByte bh 2
-          put_ bh a
-  put_ bh (IfaceProofIrrelProv a) = do
-          putByte bh 3
-          put_ bh a
-  put_ bh (IfacePluginProv a) = do
-          putByte bh 4
-          put_ bh a
-
-  get bh = do
-      tag <- getByte bh
+  put IfaceUnsafeCoerceProv = putByte 1
+  put (IfacePhantomProv a) = do
+          putByte 2
+          put a
+  put (IfaceProofIrrelProv a) = do
+          putByte 3
+          put a
+  put (IfacePluginProv a) = do
+          putByte 4
+          put a
+
+  get = do
+      tag <- getByte
       case tag of
            1 -> return $ IfaceUnsafeCoerceProv
-           2 -> do a <- get bh
+           2 -> do a <- get
                    return $ IfacePhantomProv a
-           3 -> do a <- get bh
+           3 -> do a <- get
                    return $ IfaceProofIrrelProv a
-           4 -> do a <- get bh
+           4 -> do a <- get
                    return $ IfacePluginProv a
            _ -> panic ("get IfaceUnivCoProv " ++ show tag)
 
 
 instance Binary (DefMethSpec IfaceType) where
-    put_ bh VanillaDM     = putByte bh 0
-    put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t
-    get bh = do
-            h <- getByte bh
+    put VanillaDM     = putByte 0
+    put (GenericDM t) = putByte 1 >> put t
+    get = do
+            h <- getByte
             case h of
               0 -> return VanillaDM
-              _ -> do { t <- get bh; return (GenericDM t) }
+              _ -> do { t <- get; return (GenericDM t) }
 
 instance NFData IfaceType where
   rnf = \case
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index cb9e183c1a..eee8446e35 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -105,6 +105,7 @@ import Util             hiding ( eqListBy )
 import FastString
 import Maybes
 import Binary
+import Binary.Unsafe    (ioP)
 import Fingerprint
 import Exception
 import UniqSet
@@ -484,13 +485,13 @@ addFingerprints hsc_env iface0
         -- change if the fingerprint for anything it refers to (transitively)
         -- changes.
        mk_put_name :: OccEnv (OccName,Fingerprint)
-                   -> BinHandle -> Name -> IO  ()
-       mk_put_name local_env bh name
-          | isWiredInName name  =  putNameLiterally bh name
+                   -> Name -> Put ()
+       mk_put_name local_env name
+          | isWiredInName name  =  putNameLiterally name
            -- wired-in names don't have fingerprints
           | otherwise
           = ASSERT2( isExternalName name, ppr name )
-            let hash | nameModule name /= semantic_mod =  global_hash_fn name
+            let hash | nameModule name /= semantic_mod = global_hash_fn name
                      -- Get it from the REAL interface!!
                      -- This will trigger when we compile an hsig file
                      -- and we know a backing impl for it.
@@ -507,7 +508,7 @@ addFingerprints hsc_env iface0
                 -- pprTraces below, run the compile again, and inspect
                 -- the output and the generated .hi file with
                 -- --show-iface.
-            in hash >>= put_ bh
+            in ioP hash >>= put
 
         -- take a strongly-connected group of declarations and compute
         -- its fingerprint.
@@ -910,27 +911,27 @@ ppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vca
 
 -- This instance is used only to compute fingerprints
 instance Binary IfaceDeclExtras where
-  get _bh = panic "no get for IfaceDeclExtras"
-  put_ bh (IfaceIdExtras extras) = do
-   putByte bh 1; put_ bh extras
-  put_ bh (IfaceDataExtras fix insts anns cons) = do
-   putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons
-  put_ bh (IfaceClassExtras fix insts anns methods defms) = do
-   putByte bh 3
-   put_ bh fix
-   put_ bh insts
-   put_ bh anns
-   put_ bh methods
-   put_ bh defms
-  put_ bh (IfaceSynonymExtras fix anns) = do
-   putByte bh 4; put_ bh fix; put_ bh anns
-  put_ bh (IfaceFamilyExtras fix finsts anns) = do
-   putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns
-  put_ bh IfaceOtherDeclExtras = putByte bh 6
+  get = panic "no get for IfaceDeclExtras"
+  put (IfaceIdExtras extras) = do
+   putByte 1; put extras
+  put (IfaceDataExtras fix insts anns cons) = do
+   putByte 2; put fix; put insts; put anns; put cons
+  put (IfaceClassExtras fix insts anns methods defms) = do
+   putByte 3
+   put fix
+   put insts
+   put anns
+   put methods
+   put defms
+  put (IfaceSynonymExtras fix anns) = do
+   putByte 4; put fix; put anns
+  put (IfaceFamilyExtras fix finsts anns) = do
+   putByte 5; put fix; put finsts; put anns
+  put IfaceOtherDeclExtras = putByte 6
 
 instance Binary IfaceIdExtras where
-  get _bh = panic "no get for IfaceIdExtras"
-  put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }
+  get = panic "no get for IfaceIdExtras"
+  put (IdExtras fix rules anns) = do { put fix; put rules; put anns }
 
 declExtras :: (OccName -> Maybe Fixity)
            -> (OccName -> [AnnPayload])