[commit: ghc] wip/names3: BinIface: Debugging (8a2d772)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/names3
Link       : http://ghc.haskell.org/trac/ghc/changeset/8a2d772d46212812558de3c5ab62b7813c81b1e7/ghc

>---------------------------------------------------------------

commit 8a2d772d46212812558de3c5ab62b7813c81b1e7
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Mon Aug 22 12:01:00 2016 -0400

    BinIface: Debugging


>---------------------------------------------------------------

8a2d772d46212812558de3c5ab62b7813c81b1e7
 compiler/iface/BinIface.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index e6b08b8..bd5bf90 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -303,6 +303,7 @@ putName _dict BinSymbolTable{
   | isKnownKeyName name
   , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
   = -- ASSERT(u < 2^(22 :: Int))
+    pprTrace "putName" (ppr name <+> ppr c <+> ppr u) $
     put_ bh (0x80000000 .|. (fromIntegral (ord c) `shiftL` 22) .|. (fromIntegral u :: Word32))
 
   | otherwise
@@ -310,7 +311,7 @@ putName _dict BinSymbolTable{
        case lookupUFM symtab_map name of
          Just (off,_) -> put_ bh (fromIntegral off :: Word32)
          Nothing -> do
-            off <- readFastMutInt symtab_next
+            off <- pprTrace "putName2" (ppr name) $ readFastMutInt symtab_next
             -- MASSERT(off < 2^(30 :: Int))
             writeFastMutInt symtab_next (off+1)
             writeIORef symtab_map_ref
@@ -330,9 +331,10 @@ getSymtabName _ncu _dict symtab bh = do
         let
           tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22))
           ix  = fromIntegral i .&. 0x003FFFFF
+          u   = mkUnique tag ix
         in
-          return $! case lookupKnownKeyName (mkUnique tag ix) of
-                      Nothing -> pprPanic "getSymtabName:unknown known-key unique" (ppr i)
+          return $! case lookupKnownKeyName u of
+                      Nothing -> pprPanic "getSymtabName:unknown known-key unique" (ppr i $$ ppr (unpkUnique u))
                       Just n  -> n
 
       _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)