Treat modified Binary UserData as a local state with a sub-actionwip/binary-reader/step1

2 files changed, 79 insertions, 89 deletions

diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index af0e9bfac6..75c2f9a0cb 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -166,21 +166,15 @@ getWithUserData ncu bh = do
     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
+    readState bh (error "getSymtabName") (getDictFastString dict) $ \bh -> do
+      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
+      readState bh (getSymtabName ncu dict symtab) (getDictFastString dict) get
 
 -- | Write an interface file
 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
@@ -233,38 +227,39 @@ putWithUserData log_action bh payload = do
                        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 bh (putName bin_dict bin_symtab)
+                  (putName bin_dict bin_symtab)
+                  (putFastString bin_dict) $ \bh -> do
+
+      -- Put the main thing,
+      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")
 
 
 
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 91fe256cc8..70cae8e4e8 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -143,35 +143,36 @@ writeHieFile hie_file_path hiefile = do
                       hie_dict_map  = dict_map_ref }
 
   -- put the main thing
-  let bh = setUserData bh0 $ newWriteState (putName hie_symtab)
-                                           (putName hie_symtab)
-                                           (putFastString hie_dict)
-  put_ bh hiefile
-
-  -- write the symtab pointer at the front of the file
-  symtab_p <- tellBin bh
-  putAt bh symtab_p_p symtab_p
-  seekBin bh symtab_p
-
-  -- write the symbol table itself
-  symtab_next' <- readFastMutInt symtab_next
-  symtab_map'  <- readIORef symtab_map
-  putSymbolTable bh symtab_next' symtab_map'
-
-  -- write the dictionary pointer at the front of the file
-  dict_p <- tellBin bh
-  putAt bh dict_p_p dict_p
-  seekBin bh dict_p
-
-  -- write the dictionary itself
-  dict_next <- readFastMutInt dict_next_ref
-  dict_map  <- readIORef dict_map_ref
-  putDictionary bh dict_next dict_map
-
-  -- and send the result to the file
-  createDirectoryIfMissing True (takeDirectory hie_file_path)
-  writeBinMem bh hie_file_path
-  return ()
+  writeState bh0 (putName hie_symtab)
+                 (putName hie_symtab)
+                 (putFastString hie_dict) $ \bh -> do
+
+    put_ bh hiefile
+
+    -- write the symtab pointer at the front of the file
+    symtab_p <- tellBin bh
+    putAt bh symtab_p_p symtab_p
+    seekBin bh symtab_p
+
+    -- write the symbol table itself
+    symtab_next' <- readFastMutInt symtab_next
+    symtab_map'  <- readIORef symtab_map
+    putSymbolTable bh symtab_next' symtab_map'
+
+    -- write the dictionary pointer at the front of the file
+    dict_p <- tellBin bh
+    putAt bh dict_p_p dict_p
+    seekBin bh dict_p
+
+    -- write the dictionary itself
+    dict_next <- readFastMutInt dict_next_ref
+    dict_map  <- readIORef dict_map_ref
+    putDictionary bh dict_next dict_map
+
+    -- and send the result to the file
+    createDirectoryIfMissing True (takeDirectory hie_file_path)
+    writeBinMem bh hie_file_path
+    return ()
 
 data HieFileResult
   = HieFileResult
@@ -256,19 +257,13 @@ readHieFileContents bh0 nc = do
 
   dict  <- get_dictionary bh0
 
-  -- read the symbol table so we are capable of reading the actual data
-  (bh1, nc') <- do
-      let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
-                                               (getDictFastString dict)
-      (nc', symtab) <- get_symbol_table bh1
-      let bh1' = setUserData bh1
-               $ newReadState (getSymTabName symtab)
-                              (getDictFastString dict)
-      return (bh1', nc')
-
-  -- load the actual data
-  hiefile <- get bh1
-  return (hiefile, nc')
+  readState bh0 (error "getSymtabName") (getDictFastString dict) $ \bh1 -> do
+    -- read the symbol table so we are capable of reading the actual data
+    (nc', symtab) <- get_symbol_table bh1
+    readState bh1 (getSymTabName symtab) (getDictFastString dict) $ \bh -> do
+      hiefile <- get bh
+      return (hiefile, nc')
+
   where
     get_dictionary bin_handle = do
       dict_p <- get bin_handle