[Git][ghc/ghc][wip/fendor/ghc-iface-refact] MP fixes

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/fendor/ghc-iface-refact at Glasgow Haskell Compiler / GHC


Commits:
6a86d08b by Matthew Pickering at 2024-04-04T14:20:23+01:00
MP fixes

- - - - -


3 changed files:

- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Types/FieldLabel.hs


Changes:

=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -168,7 +168,6 @@ getTables name_cache bh = do
       tables =
         [ SomeReaderTable initFastStringReaderTable
         , SomeReaderTable (initReadNameCachedBinary name_cache)
-        , SomeReaderTable @IO @BindingName (coerce (initReadNameCachedBinary name_cache))
         ]
 
     tables <- traverse (\(SomeReaderTable tblM) -> tblM >>= pure . SomeReaderTable . pure) tables
@@ -244,23 +243,16 @@ putWithTables bh' put_payload = do
     -- The order of these entries matters!
     --
     -- See Note [Iface Binary Serialiser Order] for details.
-    writerTables =
-        [ SomeWriterTable initFastStringWriterTable
-        , SomeWriterTable initWriteNameTable
-        , SomeWriterTable (fmap (second (\(BinaryWriter f) -> BinaryWriter (\bh name -> f bh (getBindingName name)))) initWriteNameTable)
-        ]
 
-  tables <- traverse (\(SomeWriterTable worker) -> worker >>= pure . SomeWriterTable . pure) writerTables
+  (fast_wt, BinaryWriter fast_w) <- initFastStringWriterTable
+  (name_wt, BinaryWriter name_w) <- initWriteNameTable
+
 
-  let writerUserData =
-        mkWriterUserData $
-          map
-            (\(SomeWriterTable tbl') -> mkSomeBinaryWriter (snd $ runIdentity tbl'))
-            tables
+  let writerUserData = newWriteState name_w name_w fast_w
 
   let bh = setWriterUserData bh' writerUserData
   (fs_count : name_count : _, r) <-
-    putAllTables bh (fmap (\(SomeWriterTable tbl) -> fst $ runIdentity tbl) tables) $ do
+    putAllTables bh [fast_wt, name_wt] $ do
       put_payload bh
 
   return (name_count, fs_count, r)


=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -120,11 +120,7 @@ type IfaceTopBndr = Name
   -- drop it when serialising and add it back in when deserialising.
 
 getIfaceTopBndr :: ReadBinHandle -> IO IfaceTopBndr
-getIfaceTopBndr bh =
-    case findUserDataReader (Proxy @BindingName) bh of
-      tbl ->
-          --pprTrace "putIfaceTopBndr" (ppr name) $
-          getBindingName <$> getEntry tbl bh
+getIfaceTopBndr bh = get bh
 
 putIfaceTopBndr :: WriteBinHandle -> IfaceTopBndr -> IO ()
 putIfaceTopBndr bh name =


=====================================
compiler/GHC/Types/FieldLabel.hs
=====================================
@@ -140,14 +140,12 @@ instance Binary Name => Binary FieldLabel where
     put_ bh (FieldLabel aa ab ac) = do
         put_ bh aa
         put_ bh ab
-        case findUserDataWriter (Proxy @BindingName) bh of
-          tbl -> putEntry tbl bh (BindingName ac)
+        put_ bh ac
     get bh = do
         aa <- get bh
         ab <- get bh
-        ac <- case findUserDataReader (Proxy @BindingName) bh of
-          tbl -> getEntry tbl bh
-        return (FieldLabel aa ab $ getBindingName ac)
+        ac <- get bh
+        return (FieldLabel aa ab ac)
 
 flIsOverloaded :: FieldLabel -> Bool
 flIsOverloaded fl =



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a86d08b4c20c3f05c0b5a959461815dd8604e15

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a86d08b4c20c3f05c0b5a959461815dd8604e15
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240404/e2d7f01d/attachment-0001.html>