Cleverer serialization for IfExtName so IfaceType can be dumberknown-key-serialization

8 files changed, 147 insertions, 87 deletions

diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs
index 39e61027f1..e7411e7883 100644
--- a/compiler/basicTypes/Unique.lhs
+++ b/compiler/basicTypes/Unique.lhs
@@ -27,7 +27,8 @@ module Unique (
 	pprUnique, 
 
 	mkUniqueGrimily,		-- Used in UniqSupply only!
-	getKey, getKeyFastInt,		-- Used in Var, UniqFM, Name only!
+        getKey, getKeyFastInt,		-- Used in Var, UniqFM, Name only!
+        mkUnique, unpkUnique,           -- Used in BinIface only
 
 	incrUnique,			-- Used for renumbering
 	deriveUnique,			-- Ditto
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 2533f57c20..6ea885b959 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -13,8 +13,9 @@ module BinIface ( writeBinIface, readBinIface, getSymtabName, getDictFastString,
 #include "HsVersions.h"
 
 import TcRnMonad
-import TyCon      (TyCon, tyConName, tupleTyConSort, tupleTyConArity, isTupleTyCon)
+import TyCon      (TyCon, tyConName, tupleTyConSort, tupleTyConArity, isTupleTyCon, tyConIP_maybe)
 import DataCon    (dataConName, dataConWorkId, dataConTyCon)
+import IParam     (ipFastString, ipTyConName)
 import PrelInfo   (wiredInThings, basicKnownKeyNames)
 import Id         (idName, isDataConWorkId_maybe)
 import TysWiredIn
@@ -44,6 +45,7 @@ import FastString
 import Constants
 
 import Data.Bits
+import Data.Char
 import Data.List
 import Data.Word
 import Data.Array
@@ -63,14 +65,14 @@ data TraceBinIFaceReading = TraceBinIFaceReading | QuietBinIFaceReading
 readBinIface :: CheckHiWay -> TraceBinIFaceReading -> FilePath
              -> TcRnIf a b ModIface
 readBinIface checkHiWay traceBinIFaceReading hi_path = do
-  update_nc <- mkNameCacheUpdater
+  ncu <- mkNameCacheUpdater
   dflags <- getDOpts
-  liftIO $ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path update_nc
+  liftIO $ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu
 
 readBinIface_ :: DynFlags -> CheckHiWay -> TraceBinIFaceReading -> FilePath
-              -> NameCacheUpdater (Array Int Name)
+              -> NameCacheUpdater
               -> IO ModIface
-readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path update_nc = do
+readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
   let printer :: SDoc -> IO ()
       printer = case traceBinIFaceReading of
                 TraceBinIFaceReading -> \sd -> printSDoc sd defaultDumpStyle
@@ -133,13 +135,13 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path update_nc = do
 
         -- Initialise the user-data field of bh
   (bh, _) <- fixIO $ \(~(_, symtab)) -> do
-    ud <- newReadState (getSymtabName symtab) (getDictFastString dict)
+    ud <- newReadState (getSymtabName ncu dict symtab) (getDictFastString dict)
     bh <- return $ setUserData bh ud
 
     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 update_nc
+    symtab <- getSymbolTable bh ncu
     seekBin bh data_p             -- Back to where we were before
     return (bh, symtab)
 
@@ -185,7 +187,7 @@ writeBinIface dflags hi_path mod_iface = do
   let bin_dict = BinDictionary {
                       bin_dict_next = dict_next_ref,
                       bin_dict_map  = dict_map_ref }
-  ud <- newWriteState (putName bin_symtab) (putFastString bin_dict)
+  ud <- newWriteState (putName bin_dict bin_symtab) (putFastString bin_dict)
 
 	-- Put the main thing, 
   bh <- return $ setUserData bh ud
@@ -243,12 +245,12 @@ putSymbolTable bh next_off symtab = do
   let names = elems (array (0,next_off-1) (eltsUFM symtab))
   mapM_ (\n -> serialiseName bh n symtab) names
 
-getSymbolTable :: BinHandle -> NameCacheUpdater (Array Int Name)
+getSymbolTable :: BinHandle -> NameCacheUpdater
                -> IO SymbolTable
-getSymbolTable bh update_namecache = do
+getSymbolTable bh ncu = do
   sz <- get bh
   od_names <- sequence (replicate sz (get bh))
-  update_namecache $ \namecache ->
+  updateNameCache ncu $ \namecache ->
     let
         arr = listArray (0,sz-1) names
         (namecache', names) =    
@@ -289,19 +291,20 @@ serialiseName bh name _ = do
 --
 -- An occurrence of a name in an interface file is serialized as a single 32-bit word.
 -- The format of this word is:
---   1. A 2-bit tag
---   2. A 30-bit payload
+--  00xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+--   A normal name. x is an index into the symbol table
+--  01xxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyy
+--   A known-key name. x is the Unique's Char, y is the int part
+--  10xxyyzzzzzzzzzzzzzzzzzzzzzzzzzzzz
+--   A tuple name:
+--    x is the tuple sort (00b ==> boxed, 01b ==> unboxed, 10b ==> constraint)
+--    y is the thing (00b ==> tycon, 01b ==> datacon, 10b ==> datacon worker)
+--    z is the arity
+--  11xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+--   An implicit parameter TyCon name. x is an index into the FastString *dictionary*
 --
--- The tag determines how the payload is interpreted. The available tags are:
---  00b ==> a normal name. The payload is an index into the symbol table
---  01b ==> a known-key name. The payload is the actual Unique
---  10b ==> a tuple. The payload is:
---    1. A 2-bit tuple sort (00b ==> boxed, 01b ==> unboxed, 10b ==> constraint)
---    2. A 2-bit thing tag  (00b ==> tycon, 01b ==> datacon, 10b ==> datacon worker)
---    3. A 26-bit arity
---
--- Note that we have to have special representation for tuples because they form
--- an "infinite" family and hence are not recorded explicitly in wiredInTyThings or
+-- Note that we have to have special representation for tuples and IP TyCons because they
+-- form an "infinite" family and hence are not recorded explicitly in wiredInTyThings or
 -- basicKnownKeyNames.
 
 knownKeyNamesMap :: UniqFM Name
@@ -312,18 +315,22 @@ knownKeyNamesMap = listToUFM_Directly [(nameUnique n, n) | n <- knownKeyNames]
                     ++ basicKnownKeyNames
 
 
-putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
-putName BinSymbolTable{ 
-            bin_symtab_map = symtab_map_ref,
-            bin_symtab_next = symtab_next }    bh name
+putName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()
+putName dict BinSymbolTable{ 
+               bin_symtab_map = symtab_map_ref,
+               bin_symtab_next = symtab_next }    bh name
   | name `elemUFM` knownKeyNamesMap
-  , let u = getKey (nameUnique name)
-  = -- ASSERT(u < 2^30)
-    put_ bh (0x40000000 .|. (fromIntegral u :: Word32))
+  , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
+  = -- ASSERT(u < 2^(22 :: Int))
+    put_ bh (0x40000000 .|. (fromIntegral (ord c) `shiftL` 22) .|. (fromIntegral u :: Word32))
   | otherwise
   = case wiredInNameTyThing_maybe name of
      Just (ATyCon tc)
-       | isTupleTyCon tc -> putTupleName_ bh tc 0
+       | isTupleTyCon tc             -> putTupleName_ bh tc 0
+       | Just ip <- tyConIP_maybe tc -> do
+         off <- allocateFastString dict (ipFastString ip)
+         -- MASSERT(off < 2^(30 :: Int))
+         put_ bh (0xC0000000 .|. off)
      Just (ADataCon dc)
        | let tc = dataConTyCon dc, isTupleTyCon tc -> putTupleName_ bh tc 1
      Just (AnId x)
@@ -334,7 +341,7 @@ putName BinSymbolTable{
          Just (off,_) -> put_ bh (fromIntegral off :: Word32)
          Nothing -> do
             off <- readFastMutInt symtab_next
-            -- MASSERT(off < 2^30)
+            -- MASSERT(off < 2^(30 :: Int))
             writeFastMutInt symtab_next (off+1)
             writeIORef symtab_map_ref
                 $! addToUFM symtab_map name (off,name)
@@ -342,7 +349,7 @@ putName BinSymbolTable{
 
 putTupleName_ :: BinHandle -> TyCon -> Word32 -> IO ()
 putTupleName_ bh tc thing_tag
-  = -- ASSERT(arity < 2^26)
+  = -- ASSERT(arity < 2^(30 :: Int))
     put_ bh (0x80000000 .|. (sort_tag `shiftL` 28) .|. (thing_tag `shiftL` 26) .|. arity)
   where
     arity = fromIntegral (tupleTyConArity tc)
@@ -351,15 +358,19 @@ putTupleName_ bh tc thing_tag
         UnboxedTuple    -> 1
         ConstraintTuple -> 2
 
-getSymtabName :: SymbolTable -> BinHandle -> IO Name
-getSymtabName symtab bh = do
+getSymtabName :: NameCacheUpdater
+              -> Dictionary -> SymbolTable
+              -> BinHandle -> IO Name
+getSymtabName ncu dict symtab bh = do
     i <- get bh
-    return $! case i .&. 0xC0000000 of
-        0x00000000 -> symtab ! fromIntegral (i ::  Word32)
-        0x40000000 -> case lookupUFM_Directly knownKeyNamesMap (mkUniqueGrimily (fromIntegral i .&. 0x3FFFFFFF)) of
+    case i .&. 0xC0000000 of
+        0x00000000 -> return $! symtab ! fromIntegral (i ::  Word32)
+        0x40000000 -> return $! case lookupUFM_Directly knownKeyNamesMap (mkUnique tag ix) of
                         Nothing -> pprPanic "getSymtabName:unknown known-key unique" (ppr i)
                         Just n  -> n
-        0x80000000 -> case thing_tag of
+          where tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22))
+                ix = fromIntegral i .&. 0x003FFFFF
+        0x80000000 -> return $! case thing_tag of
                         0 -> tyConName (tupleTyCon sort arity)
                         1 -> dataConName dc
                         2 -> idName (dataConWorkId dc)
@@ -373,6 +384,7 @@ getSymtabName symtab bh = do
                      _ -> pprPanic "getSymtabName:unknown tuple sort" (ppr i)
             thing_tag = (i .&. 0x0CFFFFFF) `shiftR` 26
             arity = fromIntegral (i .&. 0x03FFFFFF )
+        0xC0000000 -> liftM ipTyConName $ updateNameCache ncu $ flip allocateIPName (dict ! fromIntegral (i .&. 0x3FFFFFFF))
         _          -> pprPanic "getSymtabName:unknown name tag" (ppr i)
 
 data BinSymbolTable = BinSymbolTable {
@@ -383,18 +395,20 @@ data BinSymbolTable = BinSymbolTable {
 
 
 putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
-putFastString BinDictionary { bin_dict_next = j_r,
-                              bin_dict_map  = out_r}  bh f
-  = do
+putFastString dict bh fs = allocateFastString dict fs >>= put_ bh
+
+allocateFastString :: BinDictionary -> FastString -> IO Word32
+allocateFastString BinDictionary { bin_dict_next = j_r,
+                                   bin_dict_map  = out_r} f = do
     out <- readIORef out_r
     let uniq = getUnique f
     case lookupUFM out uniq of
-        Just (j, _)  -> put_ bh (fromIntegral j :: Word32)
+        Just (j, _)  -> return (fromIntegral j :: Word32)
         Nothing -> do
            j <- readFastMutInt j_r
-           put_ bh (fromIntegral j :: Word32)
            writeFastMutInt j_r (j + 1)
            writeIORef out_r $! addToUFM out uniq (j, f)
+           return (fromIntegral j :: Word32)
 
 getDictFastString :: Dictionary -> BinHandle -> IO FastString
 getDictFastString dict bh = do
@@ -1005,15 +1019,13 @@ instance Binary IfaceType where
 
 instance Binary IfaceTyCon where
    put_ bh (IfaceTc ext)  = do { putByte bh 1; put_ bh ext }
-   put_ bh (IfaceIPTc n)  = do { putByte bh 2; put_ bh n }
-   put_ bh (IfaceAnyTc k) = do { putByte bh 3; put_ bh k }
+   put_ bh (IfaceAnyTc k) = do { putByte bh 2; put_ bh k }
 
    get bh = do
 	h <- getByte bh
 	case h of
 	  1 -> do { ext <- get bh; return (IfaceTc ext) }
-	  2 -> do { n <- get bh; return (IfaceIPTc n) }
-          _ -> do { k <- get bh; return (IfaceAnyTc k) }
+	  _ -> do { k <- get bh; return (IfaceAnyTc k) }
 
 instance Binary IfaceCoCon where
    put_ bh (IfaceCoAx n)       = do { putByte bh 0; put_ bh n }
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 0b28525148..b70af407df 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -13,8 +13,8 @@ module IfaceEnv (
 	ifaceExportNames,
 
 	-- Name-cache stuff
-	allocateGlobalBinder, initNameCache, updNameCache,
-        getNameCache, mkNameCacheUpdater, NameCacheUpdater
+	allocateGlobalBinder, allocateIPName, initNameCache, updNameCache,
+        getNameCache, mkNameCacheUpdater, NameCacheUpdater(..)
    ) where
 
 #include "HsVersions.h"
@@ -149,19 +149,20 @@ lookupOrig mod occ
                   in (name_cache{ nsUniqs = us, nsNames = new_cache }, name)
     }}}
 
+allocateIPName :: NameCache -> FastString -> (NameCache, IPName Name)
+allocateIPName name_cache ip = case Map.lookup ip ipcache of
+    Just name_ip -> (name_cache, name_ip)
+    Nothing      -> (new_ns, name_ip)
+       where
+         (us_here, us') = splitUniqSupply (nsUniqs name_cache)
+         tycon_u:datacon_u:dc_wrk_u:co_ax_u:_ = uniqsFromSupply us_here
+         name_ip     = mkIPName ip tycon_u datacon_u dc_wrk_u co_ax_u
+         new_ipcache = Map.insert ip name_ip ipcache
+         new_ns      = name_cache {nsUniqs = us', nsIPs = new_ipcache}
+  where ipcache = nsIPs name_cache
+
 newIPName :: FastString -> TcRnIf m n (IPName Name)
-newIPName ip =
-  updNameCache $ \name_cache ->
-    let ipcache = nsIPs name_cache
-    in case Map.lookup ip ipcache of
-         Just name_ip -> (name_cache, name_ip)
-         Nothing      -> (new_ns, name_ip)
-            where
-              (us_here, us') = splitUniqSupply (nsUniqs name_cache)
-              tycon_u:datacon_u:dc_wrk_u:co_ax_u:_ = uniqsFromSupply us_here
-              name_ip     = mkIPName ip tycon_u datacon_u dc_wrk_u co_ax_u
-              new_ipcache = Map.insert ip name_ip ipcache
-              new_ns      = name_cache {nsUniqs = us', nsIPs = new_ipcache}
+newIPName ip = updNameCache $ flip allocateIPName ip
 \end{code}
 
 %************************************************************************
@@ -214,16 +215,16 @@ updNameCache upd_fn = do
 -- | A function that atomically updates the name cache given a modifier
 -- function.  The second result of the modifier function will be the result
 -- of the IO action.
-type NameCacheUpdater c = (NameCache -> (NameCache, c)) -> IO c
+data NameCacheUpdater = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }
 
 -- | Return a function to atomically update the name cache.
-mkNameCacheUpdater :: TcRnIf a b (NameCacheUpdater c)
+mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater
 mkNameCacheUpdater = do
   nc_var <- hsc_NC `fmap` getTopEnv
   let update_nc f = do r <- atomicModifyIORef nc_var f
                        _ <- evaluate =<< readIORef nc_var
                        return r
-  return update_nc
+  return (NCU update_nc)
 \end{code}
 
 
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 3b81c4b6cc..f2bf13d42a 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -80,12 +80,12 @@ data IfaceType	   -- A kind of universal type, used for types, kinds, and coerci
 type IfacePredType = IfaceType
 type IfaceContext = [IfacePredType]
 
-data IfaceTyCon 	-- Encodes type consructors, kind constructors
-     			-- coercion constructors, the lot
-  = IfaceTc IfExtName	-- The common case
-  | IfaceIPTc IfIPName       -- Used for implicit parameter TyCons
-  | IfaceAnyTc IfaceKind     -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
-    	       		     -- other than 'Any :: *' itself
+data IfaceTyCon 	 -- Encodes type consructors, kind constructors
+     			 -- coercion constructors, the lot
+  = IfaceTc IfExtName	 -- The common case
+  | IfaceAnyTc IfaceKind -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
+    	       		 -- other than 'Any :: *' itself
+                         -- XXX: remove this case after Any becomes kind-polymorphic
 
   -- Coercion constructors
 data IfaceCoCon
@@ -97,10 +97,8 @@ data IfaceCoCon
 
 ifaceTyConName :: IfaceTyCon -> Name
 ifaceTyConName (IfaceTc ext)           = ext
-ifaceTyConName (IfaceIPTc n)           = pprPanic "ifaceTyConName:IPTc" (ppr n)
 ifaceTyConName (IfaceAnyTc k)          = pprPanic "ifaceTyConName:AnyTc" (ppr k)
 	       		    	       	 -- Note [The Name of an IfaceAnyTc]
-                                         -- The same caveat applies to IfaceIPTc
 \end{code}
 
 Note [The Name of an IfaceAnyTc]
@@ -258,10 +256,13 @@ ppr_tc_app _         (IfaceTc n) tys
   , Just sort <- tyConTuple_maybe tc
   , tyConArity tc == length tys 
   = tupleParens sort (sep (punctuate comma (map pprIfaceType tys)))
-ppr_tc_app _         (IfaceIPTc n) [ty] = parens (ppr (IPName n) <> dcolon <> pprIfaceType ty)
-ppr_tc_app ctxt_prec tc tys 
+  | Just (ATyCon tc) <- wiredInNameTyThing_maybe n
+  , Just ip <- tyConIP_maybe tc
+  , [ty] <- tys
+  = parens (ppr ip <> dcolon <> pprIfaceType ty)
+ppr_tc_app ctxt_prec tc tys
   = maybeParen ctxt_prec tYCON_PREC 
-	       (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
+               (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
 
 ppr_tc :: IfaceTyCon -> SDoc
 -- Wrap infix type constructors in parens
@@ -270,9 +271,8 @@ ppr_tc tc		   = ppr tc
 
 -------------------
 instance Outputable IfaceTyCon where
-  ppr (IfaceIPTc n)  = ppr (IPName n)
   ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k
-      		       	     -- We can't easily get the Name of an IfaceAnyTc/IfaceIPTc
+      		       	     -- We can't easily get the Name of an IfaceAnyTc
 			     -- (see Note [The Name of an IfaceAnyTc])
 			     -- so we fake it.  It's only for debug printing!
   ppr (IfaceTc ext)  = ppr ext
@@ -344,7 +344,6 @@ toIfaceCoVar = occNameFS . getOccName
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTyCon tc 
   | isAnyTyCon tc              = IfaceAnyTc (toIfaceKind (tyConKind tc))
-  | Just n <- tyConIP_maybe tc = IfaceIPTc (ipFastString n)
   | otherwise	               = IfaceTc (tyConName tc)
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
@@ -357,7 +356,6 @@ toIfaceTyCon_name nm
 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 toIfaceWiredInTyCon tc nm
   | isAnyTyCon tc                   = IfaceAnyTc (toIfaceKind (tyConKind tc))
-  | Just n <- tyConIP_maybe tc      = IfaceIPTc (ipFastString n)
   | otherwise		            = IfaceTc nm
 
 ----------------
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 5202efa4e6..1953c4412d 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -1232,8 +1232,6 @@ tcIfaceGlobal name
 -- emasculated form (e.g. lacking data constructors).
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
-tcIfaceTyCon (IfaceIPTc n)      = do { n' <- newIPName n
-                                     ; tcWiredInTyCon (ipTyCon n') }
 tcIfaceTyCon (IfaceAnyTc kind)  = do { tc_kind <- tcIfaceType kind
                                      ; tcWiredInTyCon (anyTyConOfKind tc_kind) }
 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs
index f99f9ca292..f3a3930caf 100644
--- a/compiler/prelude/PrelInfo.lhs
+++ b/compiler/prelude/PrelInfo.lhs
@@ -70,7 +70,7 @@ Notes about wired in things
 wiredInThings :: [TyThing]
 -- This list is used only to initialise HscMain.knownKeyNames
 -- to ensure that when you say "Prelude.map" in your source code, you
--- get a Name with the correct known key
+-- get a Name with the correct known key (See Note [Known-key names])
 wiredInThings		
   = concat
     [		-- Wired in TyCons and their implicit Ids
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 02b67803b5..05e0d94dde 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -35,6 +35,57 @@ Nota Bene: all Names defined in here should come from the base package
    the uniques for these guys, only their names
 
 
+Note [Known-key names]
+~~~~~~~~~~~~~~~~~~~~~~
+
+It is *very* important that the compiler gives wired-in things and things with "known-key" names
+the correct Uniques wherever they occur. We have to be careful about this in exactly two places:
+
+  1. When we parse some source code, renaming the AST better yield an AST whose Names have the
+     correct uniques
+
+  2. When we read an interface file, the read-in gubbins better have the right uniques
+
+This is accomplished through a combination of mechanisms:
+
+  1. When parsing source code, the RdrName-decorated AST has some RdrNames which are Exact. These are
+     wired-in RdrNames where the we could directly tell from the parsed syntax what Name to use. For
+     example, when we parse a [] in a type we can just insert an Exact RdrName Name with the listTyConKey.
+
+     Currently, I believe this is just an optimisation: it would be equally valid to just output Orig
+     RdrNames that correctly record the module etc we expect the final Name to come from. However,
+     were we to eliminate isTupleOcc_maybe it would become essential (see point 3).
+
+  2. The knownKeyNames (which consist of the basicKnownKeyNames from the module, and those names reachable
+     via the wired-in stuff from TysWiredIn) are used to initialise the "original name cache" in IfaceEnv.
+     This initialization ensures that when the type checker or renamer (both of which use IfaceEnv) look up
+     an original name (i.e. a pair of a Module and an OccName) for a known-key name they get the correct Unique.
+
+     This is the most important mechanism for ensuring that known-key stuff gets the right Unique, and is why
+     it is so important to place your known-key names in the appropriate lists.
+
+  3. For "infinite families" of known-key names (i.e. tuples, Any tycons and implicit parameter TyCons), we
+     have to be extra careful. Because there are an infinite number of these things, we cannot add them to
+     the list of known-key names used to initialise the original name cache. Instead, we have to rely on
+     never having to look them up in that cache.
+
+     This is accomplished through a variety of mechanisms:
+
+       a) The known infinite families of names are specially serialised by BinIface.putName, with that special treatment
+          detected when we read back to ensure that we get back to the correct uniques.
+
+       b) Most of the infinite families cannot occur in source code, so mechanism a) sufficies to ensure that they
+          always have the right Unique. In particular, implicit param TyCon names, constraint tuples and Any TyCons
+          cannot be mentioned by the user.
+
+       c) Tuple TyCon/DataCon names have a special hack (isTupleOcc_maybe) that is used by the original name cache
+          lookup routine to detect tuple names and give them the right Unique. You might think that this is unnecessary
+          because tuple TyCon/DataCons are parsed as Exact RdrNames and *don't* appear as original names in interface files
+          (because serialization gives them special treatment), so we will never look them up in the original name cache.
+
+          However, there is a subtle reason why this is not the case: if you use setRdrNameSpace on an Exact RdrName
+          it may be turned into an Orig RdrName. So if the original name was an Exact tuple Name we might end up with
+          an Orig instead, which *will* lead to an original name cache query.
 \begin{code}
 module PrelNames (
         Unique, Uniquable(..), hasKey,  -- Re-exported for convenience
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index bad62a599b..6796102687 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -116,10 +116,9 @@ names in PrelNames, so they use wTcQual, wDataQual, etc
 -- Because of their infinite nature, this list excludes tuples, Any and implicit
 -- parameter TyCons. Instead, we have a hack in lookupOrigNameCache to deal with
 -- these names.
+--
+-- See also Note [Known-key names]
 wiredInTyCons :: [TyCon]
--- It does not need to include kind constructors, because
--- all that wiredInThings does is to initialise the Name table,
--- and kind constructors don't appear in source code.
 
 wiredInTyCons = [ unitTyCon	-- Not treated like other tuples, because
 				-- it's defined in GHC.Base, and there's only