Change the way IfExtName is serialized so (most) wired-in names get special representation

This lets IfaceType be dumber, with fewer special cases, because deserialization for more
wired-in names will work. Once we have polymorphic kinds we will be able to replace IfaceTyCon
with a simple IfExtName.

1 files changed, 24 insertions, 22 deletions

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index b61b2838ee..afbb665b46 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -18,6 +18,7 @@ module Binary
   ( {-type-}  Bin,
     {-class-} Binary(..),
     {-type-}  BinHandle,
+    SymbolTable, Dictionary,
 
    openBinIO, openBinIO_,
    openBinMem,
@@ -249,8 +250,7 @@ computeFingerprint :: Binary a
 
 computeFingerprint put_name a = do
   bh <- openBinMem (3*1024) -- just less than a block
-  ud <- newWriteState put_name putFS
-  bh <- return $ setUserData bh ud
+  bh <- return $ setUserData bh $ newWriteState put_name putFS
   put_ bh a
   fingerprintBinMem bh
 
@@ -634,31 +634,33 @@ lazyGet bh = do
 data UserData =
    UserData {
         -- for *deserialising* only:
-        ud_dict   :: Dictionary,
-        ud_symtab :: SymbolTable,
+        ud_get_name :: BinHandle -> IO Name,
+        ud_get_fs   :: BinHandle -> IO FastString,
 
         -- for *serialising* only:
         ud_put_name :: BinHandle -> Name       -> IO (),
         ud_put_fs   :: BinHandle -> FastString -> IO ()
    }
 
-newReadState :: Dictionary -> IO UserData
-newReadState dict = do
-  return UserData { ud_dict     = dict,
-                    ud_symtab   = undef "symtab",
-                    ud_put_name = undef "put_name",
-                    ud_put_fs   = undef "put_fs"
-                   }
-
+newReadState :: (BinHandle -> IO Name)
+             -> (BinHandle -> IO FastString)
+             -> UserData
+newReadState get_name get_fs
+  = UserData { ud_get_name = get_name,
+               ud_get_fs   = get_fs,
+               ud_put_name = undef "put_name",
+               ud_put_fs   = undef "put_fs"
+             }
+   
 newWriteState :: (BinHandle -> Name       -> IO ()) 
               -> (BinHandle -> FastString -> IO ())
-              -> IO UserData
-newWriteState put_name put_fs = do
-  return UserData { ud_dict     = undef "dict",
-                    ud_symtab   = undef "symtab",
-                    ud_put_name = put_name,
-                    ud_put_fs   = put_fs
-                   }
+              -> UserData
+newWriteState put_name put_fs
+  = UserData { ud_get_name = undef "get_name",
+               ud_get_fs   = undef "get_fs",
+               ud_put_name = put_name,
+               ud_put_fs   = put_fs
+             }
 
 noUserData :: a
 noUserData = undef "UserData"
@@ -736,9 +738,9 @@ instance Binary FastString where
     case getUserData bh of
         UserData { ud_put_fs = put_fs } -> put_fs bh f
 
-  get bh = do
-        j <- get bh
-        return $! (ud_dict (getUserData bh) ! (fromIntegral (j :: Word32)))
+  get bh =
+    case getUserData bh of
+        UserData { ud_get_fs = get_fs } -> get_fs bh
 
 -- Here to avoid loop