Clean up handling of known-key Names in interface files

Previously BinIface had some dedicated logic for handling tuple names in
the symbol table. As it turns out, this logic was essentially dead code
as it was superceded by the special handling of known-key things. Here
we cull the tuple code-path and use the known-key codepath for all
tuple-ish things.

This had a surprising number of knock-on effects,

 * constraint tuple datacons had to be made known-key (previously they
   were not)

 * IfaceTopBndr was changed from being a synonym of OccName to a
   synonym of Name (since we now need to be able to deserialize Names
   directly from interface files)

 * the change to IfaceTopBndr complicated fingerprinting, since we need
   to ensure that we don't go looking for the fingerprint of the thing
   we are currently fingerprinting in the fingerprint environment (see
   notes in MkIface). Handling this required distinguishing between
   binding and non-binding Name occurrences in the Binary serializers.

 * the original name cache logic which previously lived in IfaceEnv has
   been moved to a new NameCache module

 * I ripped tuples and sums out of knownKeyNames since they introduce a
   very large number of entries. During interface file deserialization
   we use static functions (defined in the new KnownUniques module) to
   map from a Unique to a known-key Name (the Unique better correspond
   to a known-key name!) When we need to do an original name cache
   lookup we rely on the parser implemented in isBuiltInOcc_maybe.

 * HscMain.allKnownKeyNames was folded into PrelInfo.knownKeyNames.

 * Lots of comments were sprinkled about describing the new scheme.

Updates haddock submodule.

Test Plan: Validate

Reviewers: niteria, simonpj, austin, hvr

Reviewed By: simonpj

Subscribers: simonmar, niteria, thomie

Differential Revision: https://phabricator.haskell.org/D2467

GHC Trac Issues: #12532, #12415

27 files changed, 955 insertions, 644 deletions

diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index b90edd90ad..0bf7c9678f 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -241,6 +241,18 @@ rnIfaceGlobal n = do
             let nsubst = mkNameShape (moduleName m) (mi_exports iface)
             return (substNameShape nsubst n)
 
+-- | Rename a DFun name. Here is where we ensure that DFuns have the correct
+-- module as described in Note [Bogus DFun renamings].
+rnIfaceDFun :: Name -> ShIfM Name
+rnIfaceDFun name = do
+    hmap <- getHoleSubst
+    dflags <- getDynFlags
+    iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
+    let m = renameHoleModule dflags hmap $ nameModule name
+    -- Doublecheck that this DFun was, indeed, locally defined.
+    MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m )
+    setNameModule (Just m) name
+
 -- PILES AND PILES OF BOILERPLATE
 
 -- | Rename an 'IfaceClsInst', with special handling for an associated
@@ -250,9 +262,6 @@ rnIfaceClsInst cls_inst = do
     n <- rnIfaceGlobal (ifInstCls cls_inst)
     tys <- mapM rnMaybeIfaceTyCon (ifInstTys cls_inst)
 
-    hmap <- getHoleSubst
-    dflags <- getDynFlags
-
     -- Note [Bogus DFun renamings]
     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
     -- Every 'IfaceClsInst' is associated with a DFun; in fact, when
@@ -312,12 +321,7 @@ rnIfaceClsInst cls_inst = do
     --    are unique; for instantiation, the final interface never
     --    mentions DFuns since they are implicitly exported.)  The
     --    important thing is that it's consistent everywhere.
-
-    iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
-    let m = renameHoleModule dflags hmap $ nameModule (ifDFun cls_inst)
-    -- Doublecheck that this DFun was, indeed, locally defined.
-    MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m )
-    dfun <- setNameModule (Just m) (ifDFun cls_inst)
+    dfun <- rnIfaceDFun (ifDFun cls_inst)
     return cls_inst { ifInstCls = n
                     , ifInstTys = tys
                     , ifDFun = dfun
@@ -339,56 +343,71 @@ rnIfaceDecl' (fp, decl) = (,) fp <$> rnIfaceDecl decl
 
 rnIfaceDecl :: Rename IfaceDecl
 rnIfaceDecl d@IfaceId{} = do
+            name <- case ifIdDetails d of
+                      IfDFunId -> rnIfaceDFun (ifName d)
+                      _        -> rnIfaceGlobal (ifName d)
             ty <- rnIfaceType (ifType d)
             details <- rnIfaceIdDetails (ifIdDetails d)
             info <- rnIfaceIdInfo (ifIdInfo d)
-            return d { ifType = ty
+            return d { ifName = name
+                     , ifType = ty
                      , ifIdDetails = details
                      , ifIdInfo = info
                      }
 rnIfaceDecl d@IfaceData{} = do
+            name <- rnIfaceGlobal (ifName d)
             binders <- mapM rnIfaceTyConBinder (ifBinders d)
             ctxt <- mapM rnIfaceType (ifCtxt d)
             cons <- rnIfaceConDecls (ifCons d)
             parent <- rnIfaceTyConParent (ifParent d)
-            return d { ifBinders = binders
+            return d { ifName = name
+                     , ifBinders = binders
                      , ifCtxt = ctxt
                      , ifCons = cons
                      , ifParent = parent
                      }
 rnIfaceDecl d@IfaceSynonym{} = do
+            name <- rnIfaceGlobal (ifName d)
             binders <- mapM rnIfaceTyConBinder (ifBinders d)
             syn_kind <- rnIfaceType (ifResKind d)
             syn_rhs <- rnIfaceType (ifSynRhs d)
-            return d { ifBinders = binders
+            return d { ifName = name
+                     , ifBinders = binders
                      , ifResKind = syn_kind
                      , ifSynRhs = syn_rhs
                      }
 rnIfaceDecl d@IfaceFamily{} = do
+            name <- rnIfaceGlobal (ifName d)
             binders <- mapM rnIfaceTyConBinder (ifBinders d)
             fam_kind <- rnIfaceType (ifResKind d)
             fam_flav <- rnIfaceFamTyConFlav (ifFamFlav d)
-            return d { ifBinders = binders
+            return d { ifName = name
+                     , ifBinders = binders
                      , ifResKind = fam_kind
                      , ifFamFlav = fam_flav
                      }
 rnIfaceDecl d@IfaceClass{} = do
+            name <- rnIfaceGlobal (ifName d)
             ctxt <- mapM rnIfaceType (ifCtxt d)
             binders <- mapM rnIfaceTyConBinder (ifBinders d)
             ats <- mapM rnIfaceAT (ifATs d)
             sigs <- mapM rnIfaceClassOp (ifSigs d)
-            return d { ifCtxt = ctxt
+            return d { ifName = name
+                     , ifCtxt = ctxt
                      , ifBinders = binders
                      , ifATs = ats
                      , ifSigs = sigs
                      }
 rnIfaceDecl d@IfaceAxiom{} = do
+            name <- rnIfaceGlobal (ifName d)
             tycon <- rnIfaceTyCon (ifTyCon d)
             ax_branches <- mapM rnIfaceAxBranch (ifAxBranches d)
-            return d { ifTyCon = tycon
+            return d { ifName = name
+                     , ifTyCon = tycon
                      , ifAxBranches = ax_branches
                      }
 rnIfaceDecl d@IfacePatSyn{} =  do
+            name <- rnIfaceGlobal (ifName d)
             let rnPat (n, b) = (,) <$> rnIfaceGlobal n <*> pure b
             pat_matcher <- rnPat (ifPatMatcher d)
             pat_builder <- T.traverse rnPat (ifPatBuilder d)
@@ -398,7 +417,8 @@ rnIfaceDecl d@IfacePatSyn{} =  do
             pat_req_ctxt <- mapM rnIfaceType (ifPatReqCtxt d)
             pat_args <- mapM rnIfaceType (ifPatArgs d)
             pat_ty <- rnIfaceType (ifPatTy d)
-            return d { ifPatMatcher = pat_matcher
+            return d { ifName = name
+                     , ifPatMatcher = pat_matcher
                      , ifPatBuilder = pat_builder
                      , ifPatUnivBndrs = pat_univ_bndrs
                      , ifPatExBndrs = pat_ex_bndrs
@@ -435,23 +455,33 @@ rnIfaceConDecls (IfAbstractTyCon b) = pure (IfAbstractTyCon b)
 
 rnIfaceConDecl :: Rename IfaceConDecl
 rnIfaceConDecl d = do
+    con_name <- rnIfaceGlobal (ifConName d)
     con_ex_tvs <- mapM rnIfaceForAllBndr (ifConExTvs d)
     let rnIfConEqSpec (n,t) = (,) n <$> rnIfaceType t
     con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d)
     con_ctxt <- mapM rnIfaceType (ifConCtxt d)
     con_arg_tys <- mapM rnIfaceType (ifConArgTys d)
+    -- TODO: It seems like we really should rename the field labels, but this
+    -- breaks due to tcIfaceDataCons projecting back to the field's OccName and
+    -- then looking up it up in the name cache. See #12699.
+    --con_fields <- mapM rnIfaceGlobal (ifConFields d)
     let rnIfaceBang (IfUnpackCo co) = IfUnpackCo <$> rnIfaceCo co
         rnIfaceBang bang = pure bang
     con_stricts <- mapM rnIfaceBang (ifConStricts d)
-    return d { ifConExTvs = con_ex_tvs
+    return d { ifConName = con_name
+             , ifConExTvs = con_ex_tvs
              , ifConEqSpec = con_eq_spec
              , ifConCtxt = con_ctxt
              , ifConArgTys = con_arg_tys
+             --, ifConFields = con_fields -- See TODO above
              , ifConStricts = con_stricts
              }
 
 rnIfaceClassOp :: Rename IfaceClassOp
-rnIfaceClassOp (IfaceClassOp n ty dm) = IfaceClassOp n <$> rnIfaceType ty <*> rnMaybeDefMethSpec dm
+rnIfaceClassOp (IfaceClassOp n ty dm) =
+    IfaceClassOp <$> rnIfaceGlobal n
+                 <*> rnIfaceType ty
+                 <*> rnMaybeDefMethSpec dm
 
 rnMaybeDefMethSpec :: Rename (Maybe (DefMethSpec IfaceType))
 rnMaybeDefMethSpec (Just (GenericDM ty)) = Just . GenericDM <$> rnIfaceType ty
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index bcb4309586..ab44b3e30a 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -484,10 +484,13 @@ instance Data Name where
 ************************************************************************
 -}
 
+-- | Assumes that the 'Name' is a non-binding one. See
+-- 'IfaceSyn.putIfaceTopBndr' and 'IfaceSyn.getIfaceTopBndr' for serializing
+-- binding 'Name's. See 'UserData' for the rationale for this distinction.
 instance Binary Name where
    put_ bh name =
       case getUserData bh of
-        UserData{ ud_put_name = put_name } -> put_name bh name
+        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name
 
    get bh =
       case getUserData bh of
diff --git a/compiler/basicTypes/Name.hs-boot b/compiler/basicTypes/Name.hs-boot
index 313db26e5c..c4eeca4d68 100644
--- a/compiler/basicTypes/Name.hs-boot
+++ b/compiler/basicTypes/Name.hs-boot
@@ -1,7 +1,3 @@
 module Name where
 
-import {-# SOURCE #-} Module
-
 data Name
-
-nameModule :: Name -> Module
diff --git a/compiler/basicTypes/NameCache.hs b/compiler/basicTypes/NameCache.hs
new file mode 100644
index 0000000000..589c7c4e3b
--- /dev/null
+++ b/compiler/basicTypes/NameCache.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+
+-- | The Name Cache
+module NameCache
+    ( lookupOrigNameCache
+    , extendOrigNameCache
+    , extendNameCache
+    , initNameCache
+    , NameCache(..), OrigNameCache
+    ) where
+
+import Module
+import Name
+import UniqSupply
+import TysWiredIn
+import Util
+import Outputable
+import PrelNames
+
+#include "HsVersions.h"
+
+{-
+
+Note [The Name Cache]
+~~~~~~~~~~~~~~~~~~~~~
+The Name Cache makes sure that, during any invocation of GHC, each
+External Name "M.x" has one, and only one globally-agreed Unique.
+
+* The first time we come across M.x we make up a Unique and record that
+  association in the Name Cache.
+
+* When we come across "M.x" again, we look it up in the Name Cache,
+  and get a hit.
+
+The functions newGlobalBinder, allocateGlobalBinder do the main work.
+When you make an External name, you should probably be calling one
+of them.
+
+
+Note [Built-in syntax and the OrigNameCache]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower
+their cost we use two tricks,
+
+  a. We specially encode tuple and sum Names in interface files' symbol tables
+     to avoid having to look up their names while loading interface files.
+     Namely these names are encoded as by their Uniques. We know how to get from
+     a Unique back to the Name which it represents via the mapping defined in
+     the SumTupleUniques module. See Note [Symbol table representation of names]
+     in BinIface and for details.
+
+  b. We don't include them in the Orig name cache but instead parse their
+     OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with
+     them.
+
+Why is the second measure necessary? Good question; afterall, 1) the parser
+emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never
+needs to looked-up during interface loading due to (a). It turns out that there
+are two reasons why we might look up an Orig RdrName for built-in syntax,
+
+  * If you use setRdrNameSpace on an Exact RdrName it may be
+    turned into an Orig RdrName.
+
+  * Template Haskell turns a BuiltInSyntax Name into a TH.NameG
+    (DsMeta.globalVar), and parses a NameG into an Orig RdrName
+    (Convert.thRdrName).  So, e.g. $(do { reify '(,); ... }) will
+    go this route (Trac #8954).
+
+-}
+
+-- | Per-module cache of original 'OccName's given 'Name's
+type OrigNameCache   = ModuleEnv (OccEnv Name)
+
+lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
+lookupOrigNameCache nc mod occ
+  | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE
+  , Just name <- isBuiltInOcc_maybe occ
+  =     -- See Note [Known-key names], 3(c) in PrelNames
+        -- Special case for tuples; there are too many
+        -- of them to pre-populate the original-name cache
+    Just name
+
+  | otherwise
+  = case lookupModuleEnv nc mod of
+        Nothing      -> Nothing
+        Just occ_env -> lookupOccEnv occ_env occ
+
+extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
+extendOrigNameCache nc name
+  = ASSERT2( isExternalName name, ppr name )
+    extendNameCache nc (nameModule name) (nameOccName name) name
+
+extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
+extendNameCache nc mod occ name
+  = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
+  where
+    combine _ occ_env = extendOccEnv occ_env occ name
+
+-- | The NameCache makes sure that there is just one Unique assigned for
+-- each original name; i.e. (module-name, occ-name) pair and provides
+-- something of a lookup mechanism for those names.
+data NameCache
+ = NameCache {  nsUniqs :: !UniqSupply,
+                -- ^ Supply of uniques
+                nsNames :: !OrigNameCache
+                -- ^ Ensures that one original name gets one unique
+   }
+
+-- | Return a function to atomically update the name cache.
+initNameCache :: UniqSupply -> [Name] -> NameCache
+initNameCache us names
+  = NameCache { nsUniqs = us,
+                nsNames = initOrigNames names }
+
+initOrigNames :: [Name] -> OrigNameCache
+initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs
index 6db4d8a97c..e24d56b8c7 100644
--- a/compiler/basicTypes/Unique.hs
+++ b/compiler/basicTypes/Unique.hs
@@ -42,9 +42,6 @@ module Unique (
         -- [the Oh-So-Wonderful Haskell module system wins again...]
         mkAlphaTyVarUnique,
         mkPrimOpIdUnique,
-        mkTupleTyConUnique, mkTupleDataConUnique,
-        mkSumTyConUnique, mkSumDataConUnique,
-        mkCTupleTyConUnique,
         mkPreludeMiscIdUnique, mkPreludeDataConUnique,
         mkPreludeTyConUnique, mkPreludeClassUnique,
         mkPArrDataConUnique, mkCoVarUnique,
@@ -53,13 +50,16 @@ module Unique (
         mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
         mkCostCentreUnique,
 
-        tyConRepNameUnique,
-        dataConWorkerUnique, dataConRepNameUnique,
-
         mkBuiltinUnique,
         mkPseudoUniqueD,
         mkPseudoUniqueE,
-        mkPseudoUniqueH
+        mkPseudoUniqueH,
+
+        -- ** Deriving uniques
+        -- *** From TyCon name uniques
+        tyConRepNameUnique,
+        -- *** From DataCon name uniques
+        dataConWorkerUnique, dataConRepNameUnique
     ) where
 
 #include "HsVersions.h"
@@ -91,6 +91,8 @@ Fast comparison is everything on @Uniques@:
 -- The type of unique identifiers that are used in many places in GHC
 -- for fast ordering and equality tests. You should generate these with
 -- the functions from the 'UniqSupply' module
+--
+-- These are sometimes also referred to as \"keys\" in comments in GHC.
 newtype Unique = MkUnique Int
 
 {-
@@ -319,18 +321,18 @@ Allocation of unique supply characters:
         d       desugarer
         f       AbsC flattener
         g       SimplStg
+        k       constraint tuple tycons
+        m       constraint tuple datacons
         n       Native codegen
         r       Hsc name cache
         s       simplifier
+        z       anonymous sums
 -}
 
 mkAlphaTyVarUnique     :: Int -> Unique
 mkPreludeClassUnique   :: Int -> Unique
 mkPreludeTyConUnique   :: Int -> Unique
-mkTupleTyConUnique     :: Boxity -> Arity -> Unique
-mkCTupleTyConUnique    :: Arity -> Unique
 mkPreludeDataConUnique :: Arity -> Unique
-mkTupleDataConUnique   :: Boxity -> Arity -> Unique
 mkPrimOpIdUnique       :: Int -> Unique
 mkPreludeMiscIdUnique  :: Int -> Unique
 mkPArrDataConUnique    :: Int -> Unique
@@ -345,9 +347,6 @@ mkPreludeClassUnique i = mkUnique '2' i
 --    * u: the TyCon itself
 --    * u+1: the TyConRepName of the TyCon
 mkPreludeTyConUnique i                = mkUnique '3' (2*i)
-mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)
-mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)
-mkCTupleTyConUnique                a  = mkUnique 'k' (2*a)
 
 tyConRepNameUnique :: Unique -> Unique
 tyConRepNameUnique  u = incrUnique u
@@ -366,30 +365,6 @@ tyConRepNameUnique  u = incrUnique u
 -- Prelude data constructors are too simple to need wrappers.
 
 mkPreludeDataConUnique i              = mkUnique '6' (3*i)    -- Must be alphabetic
-mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- ditto (*may* be used in C labels)
-mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)
-
---------------------------------------------------
--- Sum arities start from 2. The encoding is a bit funny: we break up the
--- integral part into bitfields for the arity and alternative index (which is
--- taken to be 0xff in the case of the TyCon)
---
--- TyCon for sum of arity k:
---   00000000 kkkkkkkk 11111111
--- DataCon for sum of arity k and alternative n:
---   00000000 kkkkkkkk nnnnnnnn
-
-mkSumTyConUnique :: Arity -> Unique
-mkSumTyConUnique arity =
-    ASSERT(arity < 0xff)
-    mkUnique 'z' (arity `shiftL` 8 .|. 0xff)
-
-mkSumDataConUnique :: ConTagZ -> Arity -> Unique
-mkSumDataConUnique alt arity
-  | alt >= arity
-  = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
-  | otherwise
-  = mkUnique 'z' (arity `shiftL` 8 + alt) {- skip the tycon -}
 
 --------------------------------------------------
 dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index ec02e1b481..721adff0bd 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -198,6 +198,7 @@ Library
         NameSet
         OccName
         RdrName
+        NameCache
         SrcLoc
         UniqSupply
         Unique
@@ -308,6 +309,7 @@ Library
         HsTypes
         HsUtils
         BinIface
+        BinFingerprint
         BuildTyCl
         IfaceEnv
         IfaceSyn
@@ -357,6 +359,7 @@ Library
         RdrHsSyn
         ApiAnnotation
         ForeignCall
+        KnownUniques
         PrelInfo
         PrelNames
         PrelRules
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 38eae0eee1..91a0277e03 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -434,6 +434,7 @@ compiler_stage2_dll0_MODULES = \
 	Bag \
 	BasicTypes \
 	Binary \
+	BinFingerprint \
 	BooleanFormula \
 	BufWrite \
 	Class \
@@ -487,12 +488,14 @@ compiler_stage2_dll0_MODULES = \
 	HsUtils \
 	HscTypes \
 	IOEnv \
+  NameCache \
 	Id \
 	IdInfo \
 	IfaceSyn \
 	IfaceType \
 	InstEnv \
 	Kind \
+	KnownUniques \
 	Lexeme \
 	ListSetOps \
 	Literal \
diff --git a/compiler/iface/BinFingerprint.hs b/compiler/iface/BinFingerprint.hs
new file mode 100644
index 0000000000..bbf45d7d0c
--- /dev/null
+++ b/compiler/iface/BinFingerprint.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE CPP #-}
+
+-- | Computing fingerprints of values serializeable with GHC's "Binary" module.
+module BinFingerprint
+  ( -- * Computing fingerprints
+    fingerprintBinMem
+  , computeFingerprint
+  , putNameLiterally
+  ) where
+
+#include "HsVersions.h"
+
+import Fingerprint
+import Binary
+import Name
+import Panic
+import Util
+
+fingerprintBinMem :: BinHandle -> IO Fingerprint
+fingerprintBinMem bh = withBinBuffer bh f
+  where
+    f bs =
+        -- we need to take care that we force the result here
+        -- lest a reference to the ByteString may leak out of
+        -- withBinBuffer.
+        let fp = fingerprintByteString bs
+        in fp `seq` return fp
+
+computeFingerprint :: (Binary a)
+                   => (BinHandle -> Name -> IO ())
+                   -> a
+                   -> IO Fingerprint
+computeFingerprint put_nonbinding_name a = do
+    bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
+    put_ bh a
+    fp <- fingerprintBinMem bh
+    return fp
+  where
+    set_user_data bh =
+      setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
+
+-- | Used when we want to fingerprint a structure without depending on the
+-- fingerprints of external Names that it refers to.
+putNameLiterally :: BinHandle -> Name -> IO ()
+putNameLiterally bh name = ASSERT( isExternalName name ) do
+    put_ bh $! nameModule name
+    put_ bh $! nameOccName name
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 588909130b..3de647d415 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -21,14 +21,9 @@ module BinIface (
 #include "HsVersions.h"
 
 import TcRnMonad
-import TyCon
-import ConLike
-import PrelInfo   ( knownKeyNames )
-import Id         ( idName, isDataConWorkId_maybe )
-import TysWiredIn
+import PrelInfo   ( isKnownKeyName, lookupKnownKeyName )
 import IfaceEnv
 import HscTypes
-import BasicTypes
 import Module
 import Name
 import DynFlags
@@ -41,11 +36,11 @@ import ErrUtils
 import FastMutInt
 import Unique
 import Outputable
+import NameCache
 import Platform
 import FastString
 import Constants
 import Util
-import DataCon
 
 import Data.Bits
 import Data.Char
@@ -204,10 +199,11 @@ writeBinIface dflags hi_path mod_iface = do
 
     -- Put the main thing,
     bh <- return $ setUserData bh $ newWriteState (putName bin_dict bin_symtab)
+                                                  (putName bin_dict bin_symtab)
                                                   (putFastString bin_dict)
     put_ bh mod_iface
 
-    -- Write the symtab pointer at the fornt of the file
+    -- 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
@@ -292,65 +288,33 @@ serialiseName bh name _ = do
 -- Note [Symbol table representation of names]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
--- An occurrence of a name in an interface file is serialized as a single 32-bit word.
--- The format of this word is:
+-- An occurrence of a name in an interface file is serialized as a single 32-bit
+-- word. The format of this word is:
 --  00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
 --   A normal name. x is an index into the symbol table
---  01xxxxxx xxyyyyyy yyyyyyyy yyyyyyyyyy
+--  10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
 --   A known-key name. x is the Unique's Char, y is the int part
---  100xxyyz zzzzzzzz zzzzzzzz zzzzzzzz
---   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
 --
---  10100xxx xxxxxxxx xxxxxxxx xxxxxxxx
---   A sum tycon name:
---    x is the arity
---  10101xxx xxxxxxxx xxyyyyyy yyyyyyyy
---   A sum datacon name:
---    x is the arity
---    y is the alternative
---  10110xxx xxxxxxxx xxyyyyyy yyyyyyyy
---    worker
---  11xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
---   An implicit parameter TyCon name. x is an index into the FastString *dictionary*
---
--- Note that we have to have special representation for tuples, sums, and IP
--- TyCons because they form an "infinite" family and hence are not recorded
--- explicitly in wiredInTyThings or basicKnownKeyNames.
+-- During serialization we check for known-key things using isKnownKeyName.
+-- During deserialization we use lookupKnownKeyName to get from the unique back
+-- to its corresponding Name.
 
-knownKeyNamesMap :: UniqFM Name
-knownKeyNamesMap = listToUFM_Directly [(nameUnique n, n) | n <- knownKeyNames]
 
 -- See Note [Symbol table representation of names]
 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
+               bin_symtab_next = symtab_next }
+        bh name
+  | isKnownKeyName name
   , 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))
+    put_ bh (0x80000000
+             .|. (fromIntegral (ord c) `shiftL` 22)
+             .|. (fromIntegral u :: Word32))
+
   | otherwise
-  = case wiredInNameTyThing_maybe name of
-     Just (ATyCon tc)
-       | Just sort <- tyConTuple_maybe tc -> putTupleName_ bh tc sort 0
-       | isUnboxedSumTyCon tc -> putSumTyConName_ bh tc
-     Just (AConLike (RealDataCon dc))
-       | let tc = dataConTyCon dc
-       , Just sort <- tyConTuple_maybe tc -> putTupleName_ bh tc sort 1
-       | isUnboxedSumCon dc -> putSumDataConName_ bh dc
-     Just (AnId x)
-       | Just dc <- isDataConWorkId_maybe x
-       , let tc = dataConTyCon dc
-       , Just sort <- tyConTuple_maybe tc -> putTupleName_ bh tc sort 2
-     Just (AnId x)
-       | Just dc <- isDataConWorkId_maybe x
-       , isUnboxedSumCon dc
-       -> putSumWorkerId_ bh dc
-     _ -> do
-       symtab_map <- readIORef symtab_map_ref
+  = do symtab_map <- readIORef symtab_map_ref
        case lookupUFM symtab_map name of
          Just (off,_) -> put_ bh (fromIntegral off :: Word32)
          Nothing -> do
@@ -361,41 +325,6 @@ putName _dict BinSymbolTable{
                 $! addToUFM symtab_map name (off,name)
             put_ bh (fromIntegral off :: Word32)
 
-putTupleName_ :: BinHandle -> TyCon -> TupleSort -> Word32 -> IO ()
-putTupleName_ bh tc tup_sort thing_tag
-  = ASSERT(arity < 2^(25 :: Int))
-    put_ bh (0x80000000 .|. (sort_tag `shiftL` 27) .|. (thing_tag `shiftL` 25) .|. arity)
-  where
-    (sort_tag, arity) = case tup_sort of
-      BoxedTuple      -> (0, fromIntegral (tyConArity tc))
-      UnboxedTuple    -> (1, fromIntegral (tyConArity tc `div` 2))
-        -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
-      ConstraintTuple -> pprPanic "putTupleName:ConstraintTuple" (ppr tc)
-
-putSumTyConName_ :: BinHandle -> TyCon -> IO ()
-putSumTyConName_ bh tc
-  = ASSERT(arity < 2^(27 :: Int))
-    put_ bh (0xA0000000 .|. arity)
-  where
-    arity = (fromIntegral (tyConArity tc) `div` 2) :: Word32
-
-putSumDataConName_ :: BinHandle -> DataCon -> IO ()
-putSumDataConName_ bh dc
-  = ASSERT(arity < 2^(13 :: Int) && alt < 2^(14 :: Int))
-    put_ bh (0xA8000000 .|. (arity `shiftL` 14) .|. alt)
-  where
-    tc       = dataConTyCon dc
-    alt      = fromIntegral (dataConTag dc)
-    arity    = (fromIntegral (tyConArity tc) `div` 2) :: Word32
-
-putSumWorkerId_ :: BinHandle -> DataCon -> IO ()
-putSumWorkerId_ bh dc
-  = put_ bh (0xB0000000 .|. (arity `shiftL` 14) .|. alt)
-  where
-    tc       = dataConTyCon dc
-    alt      = fromIntegral (dataConTag dc)
-    arity    = (fromIntegral (tyConArity tc) `div` 2) :: Word32
-
 -- See Note [Symbol table representation of names]
 getSymtabName :: NameCacheUpdater
               -> Dictionary -> SymbolTable
@@ -405,58 +334,17 @@ getSymtabName _ncu _dict symtab bh = do
     case i .&. 0xC0000000 of
       0x00000000 -> return $! symtab ! fromIntegral i
 
-      0x40000000 ->
+      0x80000000 ->
         let
           tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22))
           ix  = fromIntegral i .&. 0x003FFFFF
+          u   = mkUnique tag ix
         in
-          return $! case lookupUFM_Directly knownKeyNamesMap (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
 
-      0x80000000 ->
-        case i .&. 0x20000000 of
-          0x00000000 ->
-            let
-              dc = tupleDataCon sort arity
-              sort = case (i .&. 0x18000000) `shiftR` 27 of
-                       0 -> Boxed
-                       1 -> Unboxed
-                       _ -> pprPanic "getSymtabName:unknown tuple sort" (ppr i)
-              arity = fromIntegral (i .&. 0x01FFFFFF)
-            in
-              return $! case ( (i .&. 0x06FFFFFF) `shiftR` 25 ) of
-                0 -> tyConName (tupleTyCon sort arity)
-                1 -> dataConName dc
-                2 -> idName (dataConWorkId dc)
-                _ -> pprPanic "getSymtabName:unknown tuple thing" (ppr i)
-
-          0x20000000 ->
-            return $! case ((i .&. 0x18000000) `shiftR` 27) of
-              0 -> tyConName $ sumTyCon ( fromIntegral (i .&. 0x7ffffff) )
-              1 -> let
-                     alt =
-                       -- first (least significant) 14 bits
-                       fromIntegral (i .&. 0b11111111111111)
-                     arity =
-                       -- next 13 bits
-                       fromIntegral ((i `shiftR` 14) .&. 0b1111111111111)
-                   in
-                     ASSERT( arity >= alt )
-                     dataConName (sumDataCon alt arity)
-              2 -> let
-                     alt =
-                       -- first (least significant) 14 bits
-                       fromIntegral (i .&. 0b11111111111111)
-                     arity =
-                       -- next 13 bits
-                       fromIntegral ((i `shiftR` 14) .&. 0b1111111111111)
-                   in
-                     ASSERT( arity >= alt )
-                     idName (dataConWorkId (sumDataCon alt arity))
-
-              _ -> pprPanic "getSymtabName:unknown sum sort" (ppr i)
-          _ -> pprPanic "getSyntabName:unknown `tuple or sum` tag" (ppr i)
       _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
 
 data BinSymbolTable = BinSymbolTable {
diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs
index b3f3758746..10cfae6eeb 100644
--- a/compiler/iface/FlagChecker.hs
+++ b/compiler/iface/FlagChecker.hs
@@ -13,6 +13,7 @@ import HscTypes
 import Module
 import Name
 import Fingerprint
+import BinFingerprint
 -- import Outputable
 
 import qualified Data.IntSet as IntSet
@@ -21,7 +22,8 @@ import System.FilePath (normalise)
 -- | Produce a fingerprint of a @DynFlags@ value. We only base
 -- the finger print on important fields in @DynFlags@ so that
 -- the recompilation checker can use this fingerprint.
-fingerprintDynFlags :: DynFlags -> Module -> (BinHandle -> Name -> IO ())
+fingerprintDynFlags :: DynFlags -> Module
+                    -> (BinHandle -> Name -> IO ())
                     -> IO Fingerprint
 
 fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs
index 96bd36ff33..46bc0e9905 100644
--- a/compiler/iface/IfaceEnv.hs
+++ b/compiler/iface/IfaceEnv.hs
@@ -16,15 +16,13 @@ module IfaceEnv (
         ifaceExportNames,
 
         -- Name-cache stuff
-        allocateGlobalBinder,
-        initNameCache, updNameCache,
-        mkNameCacheUpdater, NameCacheUpdater(..)
+        allocateGlobalBinder, updNameCache,
+        mkNameCacheUpdater, NameCacheUpdater(..),
    ) where
 
 #include "HsVersions.h"
 
 import TcRnMonad
-import TysWiredIn
 import HscTypes
 import Type
 import Var
@@ -34,10 +32,9 @@ import Module
 import FastString
 import FastStringEnv
 import IfaceType
-import PrelNames ( gHC_TYPES, gHC_PRIM, gHC_TUPLE )
+import NameCache
 import UniqSupply
 import SrcLoc
-import Util
 
 import Outputable
 import Data.List     ( partition )
@@ -49,20 +46,7 @@ import Data.List     ( partition )
 *                                                      *
 *********************************************************
 
-Note [The Name Cache]
-~~~~~~~~~~~~~~~~~~~~~
-The Name Cache makes sure that, during any invocation of GHC, each
-External Name "M.x" has one, and only one globally-agreed Unique.
-
-* The first time we come across M.x we make up a Unique and record that
-  association in the Name Cache.
-
-* When we come across "M.x" again, we look it up in the Name Cache,
-  and get a hit.
-
-The functions newGlobalBinder, allocateGlobalBinder do the main work.
-When you make an External name, you should probably be calling one
-of them.
+See Also: Note [The Name Cache] in NameCache
 -}
 
 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
@@ -136,6 +120,28 @@ allocateGlobalBinder name_supply mod occ loc
 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
 ifaceExportNames exports = return exports
 
+-- | 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.
+newtype NameCacheUpdater
+      = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }
+
+mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater
+mkNameCacheUpdater = do { hsc_env <- getTopEnv
+                        ; return (NCU (updNameCacheIO hsc_env)) }
+
+updNameCache :: (NameCache -> (NameCache, c)) -> TcRnIf a b c
+updNameCache upd_fn = do { hsc_env <- getTopEnv
+                         ; liftIO $ updNameCacheIO hsc_env upd_fn }
+
+{-
+************************************************************************
+*                                                                      *
+                Name cache access
+*                                                                      *
+************************************************************************
+-}
+
 -- | Look up the 'Name' for a given 'Module' and 'OccName'.
 -- Consider alternately using 'lookupIfaceTop' if you're in the 'IfL' monad
 -- and 'Module' is simply that of the 'ModIface' you are typechecking.
@@ -148,7 +154,7 @@ lookupOrig mod occ
                 --      which does some stuff that modifies the name cache
                 -- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)
           mod `seq` occ `seq` return ()
---      ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
+        ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
 
         ; updNameCache $ \name_cache ->
           case lookupOrigNameCache (nsNames name_cache) mod occ of {
@@ -184,92 +190,6 @@ setNameModule (Just m) n =
 {-
 ************************************************************************
 *                                                                      *
-                Name cache access
-*                                                                      *
-************************************************************************
-
-See Note [The Name Cache] above.
-
-Note [Built-in syntax and the OrigNameCache]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower
-their cost we use two tricks,
-
-  b. We specially encode tuple Names in interface files' symbols tables to avoid
-     having to look up their names at all while loading interface files. See
-     Note [Symbol table representation of names] in BinIface for details.
-
-  a. We don't include them in the Orig name cache but instead parse their
-     OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with
-     them.
-
-Why is the second measure necessary? Good question; afterall, 1) the parser
-emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never
-needs to looked-up during interface loading due to (a). It turns out that there
-are two reasons why we might look up an Orig RdrName for built-in syntax,
-
-  * If you use setRdrNameSpace on an Exact RdrName it may be
-    turned into an Orig RdrName.
-
-  * Template Haskell turns a BuiltInSyntax Name into a TH.NameG
-    (DsMeta.globalVar), and parses a NameG into an Orig RdrName
-    (Convert.thRdrName).  So, e.g. $(do { reify '(,); ... }) will
-    go this route (Trac #8954).
-
--}
-
-lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
-lookupOrigNameCache nc mod occ
-  | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE
-  , Just name <- isBuiltInOcc_maybe occ
-  =     -- See Note [Known-key names], 3(c) in PrelNames
-        -- Special case for tuples; there are too many
-        -- of them to pre-populate the original-name cache
-    Just name
-
-  | otherwise
-  = case lookupModuleEnv nc mod of
-        Nothing      -> Nothing
-        Just occ_env -> lookupOccEnv occ_env occ
-
-extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
-extendOrigNameCache nc name
-  = ASSERT2( isExternalName name, ppr name )
-    extendNameCache nc (nameModule name) (nameOccName name) name
-
-extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
-extendNameCache nc mod occ name
-  = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
-  where
-    combine _ occ_env = extendOccEnv occ_env occ name
-
-updNameCache :: (NameCache -> (NameCache, c)) -> TcRnIf a b c
-updNameCache upd_fn = do { hsc_env <- getTopEnv
-                         ; liftIO $ updNameCacheIO hsc_env upd_fn }
-
--- | 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.
-newtype NameCacheUpdater
-      = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }
-
--- | Return a function to atomically update the name cache.
-mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater
-mkNameCacheUpdater = do { hsc_env <- getTopEnv
-                        ; return (NCU (updNameCacheIO hsc_env)) }
-
-initNameCache :: UniqSupply -> [Name] -> NameCache
-initNameCache us names
-  = NameCache { nsUniqs = us,
-                nsNames = initOrigNames names }
-
-initOrigNames :: [Name] -> OrigNameCache
-initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
-
-{-
-************************************************************************
-*                                                                      *
                 Type variables and local Ids
 *                                                                      *
 ************************************************************************
@@ -335,27 +255,10 @@ extendIfaceEnvs tcvs thing_inside
 ************************************************************************
 -}
 
+-- | Look up a top-level name from the current Iface module
 lookupIfaceTop :: OccName -> IfL Name
--- Look up a top-level name from the current Iface module
-lookupIfaceTop occ = do
-    lcl_env <- getLclEnv
-    -- NB: this is a semantic module, see
-    -- Note [Identity versus semantic module]
-    mod <- getIfModule
-    case if_nsubst lcl_env of
-        -- NOT substNameShape because 'getIfModule' returns the
-        -- renamed module (d'oh!)
-        Just nsubst ->
-            case lookupOccEnv (ns_map nsubst) occ of
-              Just n' ->
-                -- I thought this would be help but it turns out
-                -- n' doesn't have any useful information. Drat!
-                -- return (setNameLoc n' (nameSrcSpan n))
-                return n'
-              -- This case can occur when we encounter a DFun;
-              -- see Note [Bogus DFun renamings]
-              Nothing -> lookupOrig mod occ
-        _ -> lookupOrig mod occ
+lookupIfaceTop occ
+  = do  { env <- getLclEnv; lookupOrig (if_mod env) occ }
 
 newIfaceName :: OccName -> IfL Name
 newIfaceName occ
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 8a45dd55be..81d905de0b 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -20,6 +20,10 @@ module IfaceSyn (
         IfaceAxBranch(..),
         IfaceTyConParent(..),
 
+        -- * Binding names
+        IfaceTopBndr,
+        putIfaceTopBndr, getIfaceTopBndr,
+
         -- Misc
         ifaceDeclImplicitBndrs, visibleIfConDecls,
         ifaceConDeclFields,
@@ -37,6 +41,7 @@ module IfaceSyn (
 #include "HsVersions.h"
 
 import IfaceType
+import BinFingerprint
 import CoreSyn( IsOrphan )
 import PprCore()            -- Printing DFunArgs
 import Demand
@@ -78,15 +83,29 @@ infixl 3 &&&
 ************************************************************************
 -}
 
-type IfaceTopBndr = OccName
-  -- It's convenient to have an OccName in the IfaceSyn, although in each
+-- | A binding top-level 'Name' in an interface file (e.g. the name of an
+-- 'IfaceDecl').
+type IfaceTopBndr = Name
+  -- It's convenient to have an Name in the IfaceSyn, although in each
   -- case the namespace is implied by the context. However, having an
-  -- OccNames makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
-  -- very convenient.
+  -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
+  -- very convenient. Moreover, having the key of the binder means that
+  -- we can encode known-key things cleverly in the symbol table. See Note
+  -- [Symbol table representation of Names]
   --
   -- We don't serialise the namespace onto the disk though; rather we
   -- drop it when serialising and add it back in when deserialising.
 
+getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
+getIfaceTopBndr bh = get bh
+
+putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
+putIfaceTopBndr bh name =
+    case getUserData bh of
+      UserData{ ud_put_binding_name = put_binding_name } ->
+          --pprTrace "putIfaceTopBndr" (ppr name) $
+          put_binding_name bh name
+
 data IfaceDecl
   = IfaceId { ifName      :: IfaceTopBndr,
               ifType      :: IfaceType,
@@ -202,7 +221,7 @@ data IfaceConDecls
 
 data IfaceConDecl
   = IfCon {
-        ifConOcc     :: IfaceTopBndr,                -- Constructor name
+        ifConName    :: IfaceTopBndr,                -- Constructor name
         ifConWrapper :: Bool,                   -- True <=> has a wrapper
         ifConInfix   :: Bool,                   -- True <=> declared infix
 
@@ -350,7 +369,8 @@ ifaceConDeclFields x = case x of
     IfDataTyCon cons is_over labels -> map (help cons  is_over) labels
     IfNewTyCon  con  is_over labels -> map (help [con] is_over) labels
   where
-    help (dc:_) is_over lbl = mkFieldLabelOccs lbl (ifConOcc dc) is_over
+    help (dc:_) is_over lbl =
+        mkFieldLabelOccs lbl (occName $ ifConName dc) is_over
     help [] _ _ = error "ifaceConDeclFields: data type has no constructors!"
 
 ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
@@ -365,14 +385,16 @@ ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 -- The order of the list does not matter.
 
-ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ, ifCons = cons })
+ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
   = case cons of
       IfAbstractTyCon {}  -> []
-      IfNewTyCon  cd  _ _ -> mkNewTyCoOcc tc_occ : ifaceConDeclImplicitBndrs cd
+      IfNewTyCon  cd  _ _ -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd
       IfDataTyCon cds _ _ -> concatMap ifaceConDeclImplicitBndrs cds
 
-ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt, ifName = cls_tc_occ
-                                   , ifSigs = sigs, ifATs = ats })
+ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt
+                                   , ifName = cls_tc_name
+                                   , ifSigs = sigs
+                                   , ifATs = ats })
   = --   (possibly) newtype coercion
     co_occs ++
     --    data constructor (DataCon namespace)
@@ -380,12 +402,13 @@ ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt, ifName = cls_tc_occ
     --    no wrapper (class dictionaries never have a wrapper)
     [dc_occ, dcww_occ] ++
     -- associated types
-    [ifName at | IfaceAT at _ <- ats ] ++
+    [occName (ifName at) | IfaceAT at _ <- ats ] ++
     -- superclass selectors
     [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
     -- operation selectors
-    [op | IfaceClassOp op  _ _ <- sigs]
+    [occName op | IfaceClassOp op  _ _ <- sigs]
   where
+    cls_tc_occ = occName cls_tc_name
     n_ctxt = length sc_ctxt
     n_sigs = length sigs
     co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
@@ -397,9 +420,10 @@ ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt, ifName = cls_tc_occ
 ifaceDeclImplicitBndrs _ = []
 
 ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
-ifaceConDeclImplicitBndrs (IfCon { ifConWrapper = has_wrapper, ifConOcc = con_occ })
-  = [con_occ, work_occ] ++ wrap_occs
+ifaceConDeclImplicitBndrs (IfCon { ifConWrapper = has_wrapper, ifConName = con_name })
+  = [occName con_name, work_occ] ++ wrap_occs
   where
+    con_occ = occName con_name
     work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
     wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
               | otherwise   = []
@@ -413,7 +437,7 @@ ifaceConDeclImplicitBndrs (IfCon { ifConWrapper = has_wrapper, ifConOcc = con_oc
        -- declaration with the name of the binder. (#5614, #7215)
 ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)]
 ifaceDeclFingerprints hash decl
-  = (ifName decl, hash) :
+  = (getOccName decl, hash) :
     [ (occ, computeFingerprint' (hash,occ))
     | occ <- ifaceDeclImplicitBndrs decl ]
   where
@@ -527,14 +551,23 @@ pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
 instance Outputable IfaceAnnotation where
   ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
 
+instance NamedThing IfaceClassOp where
+  getName (IfaceClassOp n _ _) = n
+
 instance HasOccName IfaceClassOp where
-  occName (IfaceClassOp n _ _) = n
+  occName = getOccName
+
+instance NamedThing IfaceConDecl where
+  getName = ifConName
 
 instance HasOccName IfaceConDecl where
-  occName = ifConOcc
+  occName = getOccName
+
+instance NamedThing IfaceDecl where
+  getName = ifName
 
 instance HasOccName IfaceDecl where
-  occName = ifName
+  occName = getOccName
 
 instance Outputable IfaceDecl where
   ppr = pprIfaceDecl showAll
@@ -548,6 +581,7 @@ filtering of method signatures. Instead we just check if anything at all is
 filtered and hide it in that case.
 -}
 
+-- TODO: Kill this and Note [Printing IfaceDecl binders]
 data ShowSub
   = ShowSub
       { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
@@ -647,7 +681,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
     pp_roles
       | is_data_instance = empty
       | otherwise        = pprRoles (== Representational)
-                                    (pprPrefixIfDeclBndr ss tycon)
+                                    (pprPrefixIfDeclBndr ss (occName tycon))
                                     binders roles
             -- Don't display roles for data family instances (yet)
             -- See discussion on Trac #8672.
@@ -675,7 +709,7 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs
                             , ifRoles = roles
                             , ifFDs    = fds, ifMinDef = minDef
                             , ifBinders = binders })
-  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) binders roles
+  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss (occName clas)) binders roles
          , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
                                 <+> pprFundeps fds <+> pp_where
          , nest 2 (vcat [ vcat asocs, vcat dsigs
@@ -749,7 +783,7 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon
 
     pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
       = hang (text "where")
-           2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
+           2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss (occName tycon))) brs)
               $$ ppShowIface ss (text "axiom" <+> ppr ax))
     pp_branches _ = Outputable.empty
 
@@ -775,7 +809,7 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name,
 
 pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
                               ifIdDetails = details, ifIdInfo = info })
-  = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
+  = vcat [ hang (pprPrefixIfDeclBndr ss (occName var) <+> dcolon)
               2 (pprIfaceSigmaType ty)
          , ppShowIface ss (ppr details)
          , ppShowIface ss (ppr info) ]
@@ -801,10 +835,10 @@ pprRoles suppress_if tyCon bndrs roles
          text "type role" <+> tyCon <+> hsep (map ppr froles)
 
 pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
-pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
-  = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
-pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
-  = parenSymOcc occ (ppr_bndr occ)
+pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) name
+  = pprInfixVar (isSymOcc name) (ppr_bndr name)
+pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) name
+  = parenSymOcc name (ppr_bndr name)
 
 instance Outputable IfaceClassOp where
    ppr = pprIfaceClassOp showAll
@@ -817,7 +851,7 @@ pprIfaceClassOp ss (IfaceClassOp n ty dm)
               =  text "default" <+> pp_sig n dm_ty
               | otherwise
               = empty
-   pp_sig n ty = pprPrefixIfDeclBndr ss n <+> dcolon <+> pprIfaceSigmaType ty
+   pp_sig n ty = pprPrefixIfDeclBndr ss (occName n) <+> dcolon <+> pprIfaceSigmaType ty
 
 instance Outputable IfaceAT where
    ppr = pprIfaceAT showAll
@@ -841,14 +875,14 @@ pprIfaceTyConParent (IfDataInstance _ tc tys)
     let ftys = stripInvisArgs dflags tys
     in pprIfaceTypeApp tc ftys
 
-pprIfaceDeclHead :: IfaceContext -> ShowSub -> OccName
+pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name
                  -> [IfaceTyConBinder]   -- of the tycon, for invisible-suppression
                  -> Maybe IfaceKind
                  -> SDoc
 pprIfaceDeclHead context ss tc_occ bndrs m_res_kind
   = sdocWithDynFlags $ \ dflags ->
     sep [ pprIfaceContextArr context
-        , pprPrefixIfDeclBndr ss tc_occ
+        , pprPrefixIfDeclBndr ss (occName tc_occ)
           <+> pprIfaceTyConBinders (suppressIfaceInvisibles dflags bndrs bndrs)
         , maybe empty (\res_kind -> dcolon <+> pprIfaceType res_kind) m_res_kind ]
 
@@ -865,19 +899,19 @@ pprIfaceConDecl :: ShowSub -> Bool
                 -> IfaceTyConParent
                 -> IfaceConDecl -> SDoc
 pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
-        (IfCon { ifConOcc = name, ifConInfix = is_infix,
+        (IfCon { ifConName = name, ifConInfix = is_infix,
                  ifConExTvs = ex_tvs,
                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
                  ifConStricts = stricts, ifConFields = fields })
   | gadt_style            = pp_prefix_con <+> dcolon <+> ppr_ty
   | not (null fields)     = pp_prefix_con <+> pp_field_args
   | is_infix
-  , [ty1, ty2] <- pp_args = sep [ty1, pprInfixIfDeclBndr ss name, ty2]
+  , [ty1, ty2] <- pp_args = sep [ty1, pprInfixIfDeclBndr ss (occName name), ty2]
   | otherwise             = pp_prefix_con <+> sep pp_args
   where
     tys_w_strs :: [(IfaceBang, IfaceType)]
     tys_w_strs = zip stricts arg_tys
-    pp_prefix_con = pprPrefixIfDeclBndr ss name
+    pp_prefix_con = pprPrefixIfDeclBndr ss (occName name)
 
     (univ_tvs, pp_res_ty) = mk_user_con_res_ty eq_spec
     ppr_ty = pprIfaceForAllPart (map tv_to_forall_bndr univ_tvs ++ ex_tvs)
@@ -906,16 +940,18 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
 
     pp_field_args :: SDoc  -- Braces form:  { x :: !Maybe a, y :: Int }
     pp_field_args = braces $ sep $ punctuate comma $ ppr_trim $
-                    map maybe_show_label (zip fields tys_w_strs)
+                    zipWith maybe_show_label fields tys_w_strs
 
-    maybe_show_label (sel,bty)
+    maybe_show_label :: IfaceTopBndr -> (IfaceBang, IfaceType) -> Maybe SDoc
+    maybe_show_label sel bty
       | showSub ss sel = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty)
       | otherwise      = Nothing
       where
         -- IfaceConDecl contains the name of the selector function, so
         -- we have to look up the field label (in case
         -- DuplicateRecordFields was used for the definition)
-        lbl = maybe sel (mkVarOccFS . flLabel) $ find (\ fl -> flSelector fl == sel) fls
+        lbl = maybe (occName sel) (mkVarOccFS . flLabel)
+              $ find (\ fl -> flSelector fl == occName sel) fls
 
     mk_user_con_res_ty :: IfaceEqSpec -> ([IfaceTvBndr], SDoc)
     -- See Note [Result type of a data family GADT]
@@ -930,7 +966,7 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
         con_univ_tvs = filterOut done_univ_tv (map ifTyConBinderTyVar tc_binders)
 
     ppr_tc_app gadt_subst dflags
-       = pprPrefixIfDeclBndr ss tycon
+       = pprPrefixIfDeclBndr ss (occName tycon)
          <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
                  | (tv,_kind)
                      <- map ifTyConBinderTyVar $
@@ -1434,19 +1470,26 @@ to take account of the use of the data constructor PS in the pattern match.
                 Binary instances
 *                                                                      *
 ************************************************************************
+
+Note that there is a bit of subtlety here when we encode names. While
+IfaceTopBndrs is really just a synonym for Name, we need to take care to
+encode them with {get,put}IfaceTopBndr. The difference becomes important when
+we go to fingerprint an IfaceDecl. See Note [Fingerprinting IfaceDecls] for
+details.
+
 -}
 
 instance Binary IfaceDecl where
     put_ bh (IfaceId name ty details idinfo) = do
         putByte bh 0
-        put_ bh (occNameFS name)
+        putIfaceTopBndr bh name
         put_ bh ty
         put_ bh details
         put_ bh idinfo
 
     put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
         putByte bh 2
-        put_ bh (occNameFS a1)
+        putIfaceTopBndr bh a1
         put_ bh a2
         put_ bh a3
         put_ bh a4
@@ -1458,7 +1501,7 @@ instance Binary IfaceDecl where
 
     put_ bh (IfaceSynonym a1 a2 a3 a4 a5) = do
         putByte bh 3
-        put_ bh (occNameFS a1)
+        putIfaceTopBndr bh a1
         put_ bh a2
         put_ bh a3
         put_ bh a4
@@ -1466,7 +1509,7 @@ instance Binary IfaceDecl where
 
     put_ bh (IfaceFamily a1 a2 a3 a4 a5 a6) = do
         putByte bh 4
-        put_ bh (occNameFS a1)
+        putIfaceTopBndr bh a1
         put_ bh a2
         put_ bh a3
         put_ bh a4
@@ -1476,7 +1519,7 @@ instance Binary IfaceDecl where
     put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8) = do
         putByte bh 5
         put_ bh a1
-        put_ bh (occNameFS a2)
+        putIfaceTopBndr bh a2
         put_ bh a3
         put_ bh a4
         put_ bh a5
@@ -1486,14 +1529,14 @@ instance Binary IfaceDecl where
 
     put_ bh (IfaceAxiom a1 a2 a3 a4) = do
         putByte bh 6
-        put_ bh (occNameFS a1)
+        putIfaceTopBndr bh a1
         put_ bh a2
         put_ bh a3
         put_ bh a4
 
-    put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
+    put_ bh (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
         putByte bh 7
-        put_ bh (occNameFS name)
+        putIfaceTopBndr bh a1
         put_ bh a2
         put_ bh a3
         put_ bh a4
@@ -1512,10 +1555,9 @@ instance Binary IfaceDecl where
                     ty      <- get bh
                     details <- get bh
                     idinfo  <- get bh
-                    occ <- return $! mkVarOccFS name
-                    return (IfaceId occ ty details idinfo)
+                    return (IfaceId name ty details idinfo)
             1 -> error "Binary.get(TyClDecl): ForeignType"
-            2 -> do a1  <- get bh
+            2 -> do a1  <- getIfaceTopBndr bh
                     a2  <- get bh
                     a3  <- get bh
                     a4  <- get bh
@@ -1524,40 +1566,35 @@ instance Binary IfaceDecl where
                     a7  <- get bh
                     a8  <- get bh
                     a9  <- get bh
-                    occ <- return $! mkTcOccFS a1
-                    return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9)
-            3 -> do a1 <- get bh
+                    return (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9)
+            3 -> do a1 <- getIfaceTopBndr bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
                     a5 <- get bh
-                    occ <- return $! mkTcOccFS a1
-                    return (IfaceSynonym occ a2 a3 a4 a5)
-            4 -> do a1 <- get bh
+                    return (IfaceSynonym a1 a2 a3 a4 a5)
+            4 -> do a1 <- getIfaceTopBndr bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
                     a5 <- get bh
                     a6 <- get bh
-                    occ <- return $! mkTcOccFS a1
-                    return (IfaceFamily occ a2 a3 a4 a5 a6)
+                    return (IfaceFamily a1 a2 a3 a4 a5 a6)
             5 -> do a1 <- get bh
-                    a2 <- get bh
+                    a2 <- getIfaceTopBndr bh
                     a3 <- get bh
                     a4 <- get bh
                     a5 <- get bh
                     a6 <- get bh
                     a7 <- get bh
                     a8 <- get bh
-                    occ <- return $! mkClsOccFS a2
-                    return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8)
-            6 -> do a1 <- get bh
+                    return (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8)
+            6 -> do a1 <- getIfaceTopBndr bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
-                    occ <- return $! mkTcOccFS a1
-                    return (IfaceAxiom occ a2 a3 a4)
-            7 -> do a1 <- get bh
+                    return (IfaceAxiom a1 a2 a3 a4)
+            7 -> do a1 <- getIfaceTopBndr bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
@@ -1568,8 +1605,7 @@ instance Binary IfaceDecl where
                     a9 <- get bh
                     a10 <- get bh
                     a11 <- get bh
-                    occ <- return $! mkDataOccFS a1
-                    return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
+                    return (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
             _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
 
 instance Binary IfaceFamTyConFlav where
@@ -1592,15 +1628,14 @@ instance Binary IfaceFamTyConFlav where
 
 instance Binary IfaceClassOp where
     put_ bh (IfaceClassOp n ty def) = do
-        put_ bh (occNameFS n)
+        putIfaceTopBndr bh n
         put_ bh ty
         put_ bh def
     get bh = do
-        n   <- get bh
+        n   <- getIfaceTopBndr bh
         ty  <- get bh
         def <- get bh
-        occ <- return $! mkVarOccFS n
-        return (IfaceClassOp occ ty def)
+        return (IfaceClassOp n ty def)
 
 instance Binary IfaceAT where
     put_ bh (IfaceAT dec defs) = do
@@ -1642,25 +1677,27 @@ instance Binary IfaceConDecls where
 
 instance Binary IfaceConDecl where
     put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
-        put_ bh a1
+        putIfaceTopBndr bh a1
         put_ bh a2
         put_ bh a3
         put_ bh a4
         put_ bh a5
         put_ bh a6
         put_ bh a7
-        put_ bh a8
+        put_ bh (length a8)
+        mapM_ (putIfaceTopBndr bh) a8
         put_ bh a9
         put_ bh a10
     get bh = do
-        a1 <- get bh
+        a1 <- getIfaceTopBndr bh
         a2 <- get bh
         a3 <- get bh
         a4 <- get bh
         a5 <- get bh
         a6 <- get bh
         a7 <- get bh
-        a8 <- get bh
+        n_fields <- get bh
+        a8 <- replicateM n_fields (getIfaceTopBndr bh)
         a9 <- get bh
         a10 <- get bh
         return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 97f288f7ba..48bc316d0a 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -141,8 +141,10 @@ importDecl name
         -- Now look it up again; this time we should find it
         { eps <- getEps
         ; case lookupTypeEnv (eps_PTE eps) name of
-            Just thing -> return (Succeeded thing)
-            Nothing    -> return $ Failed (ifPprDebug (found_things_msg eps) $$ not_found_msg)
+            Just thing -> return $ Succeeded thing
+            Nothing    -> let doc = ifPprDebug (found_things_msg eps $$ empty)
+                                    $$ not_found_msg
+                          in return $ Failed doc
     }}}
   where
     nd_doc = text "Need decl for" <+> ppr name
@@ -653,7 +655,7 @@ loadDecl :: Bool                    -- Don't load pragmas into the decl pool
 loadDecl ignore_prags (_version, decl)
   = do  {       -- Populate the name cache with final versions of all
                 -- the names associated with the decl
-          main_name      <- lookupIfaceTop (ifName decl)
+          let main_name = ifName decl
 
         -- Typecheck the thing, lazily
         -- NB. Firstly, the laziness is there in case we never need the
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 0c2c8a4831..12980e4524 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -59,6 +59,7 @@ Basic idea:
 #include "HsVersions.h"
 
 import IfaceSyn
+import BinFingerprint
 import LoadIface
 import FlagChecker
 
@@ -390,6 +391,32 @@ mkHashFun hsc_env eps name
 -- ---------------------------------------------------------------------------
 -- Compute fingerprints for the interface
 
+{-
+Note [Fingerprinting IfaceDecls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The general idea here is that we first examine the 'IfaceDecl's and determine
+the recursive groups of them. We then walk these groups in dependency order,
+serializing each contained 'IfaceDecl' to a "Binary" buffer which we then
+hash using MD5 to produce a fingerprint for the group.
+
+However, the serialization that we use is a bit funny: we override the @putName@
+operation with our own which serializes the hash of a 'Name' instead of the
+'Name' itself. This ensures that the fingerprint of a decl changes if anything
+in its transitive closure changes. This trick is why we must be careful about
+traversing in dependency order: we need to ensure that we have hashes for
+everything referenced by the decl which we are fingerprinting.
+
+Moreover, we need to be careful to distinguish between serialization of binding
+Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls
+field of a IfaceClsInst): only in the non-binding case should we include the
+fingerprint; in the binding case we shouldn't since it is merely the name of the
+thing that we are currently fingerprinting.
+-}
+
+-- | Add fingerprints for top-level declarations to a 'ModIface'.
+--
+-- See Note [Fingerprinting IfaceDecls]
 addFingerprints
         :: HscEnv
         -> Maybe Fingerprint -- the old fingerprint, if any
@@ -414,14 +441,15 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                                   non_orph_fis decl
 
        edges :: [(IfaceDeclABI, Unique, [Unique])]
-       edges = [ (abi, getUnique (ifName decl), out)
+       edges = [ (abi, getUnique (getOccName decl), out)
                | decl <- new_decls
                , let abi = declABI decl
                , let out = localOccs $ freeNamesDeclABI abi
                ]
 
        name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
-       localOccs = map (getUnique . getParent . getOccName)
+       localOccs =
+         map (getUnique . getParent . getOccName)
                         -- NB: names always use semantic module, so
                         -- filtering must be on the semantic module!
                         -- See Note [Identity versus semantic module]
@@ -432,7 +460,8 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                    -- stronglyConnCompFromEdgedVertices is deterministic
                    -- even with non-deterministic order of edges as
                    -- explained in Note [Deterministic SCC] in Digraph.
-          where getParent occ = lookupOccEnv parent_map occ `orElse` occ
+          where getParent :: OccName -> OccName
+                getParent occ = lookupOccEnv parent_map occ `orElse` occ
 
         -- maps OccNames to their parents in the current module.
         -- e.g. a reference to a constructor must be turned into a reference
@@ -441,20 +470,22 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
        parent_map = foldr extend emptyOccEnv new_decls
           where extend d env =
                   extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
-                  where n = ifName d
+                  where n = getOccName d
 
         -- strongly-connected groups of declarations, in dependency order
-       groups = stronglyConnCompFromEdgedVerticesUniq edges
+       groups :: [SCC IfaceDeclABI]
+       groups =
+           stronglyConnCompFromEdgedVerticesUniq edges
 
        global_hash_fn = mkHashFun hsc_env eps
 
-        -- how to output Names when generating the data to fingerprint.
+        -- How to output Names when generating the data to fingerprint.
         -- Here we want to output the fingerprint for each top-level
         -- Name, whether it comes from the current module or another
         -- module.  In this way, the fingerprint for a declaration will
         -- change if the fingerprint for anything it refers to (transitively)
         -- changes.
-       mk_put_name :: (OccEnv (OccName,Fingerprint))
+       mk_put_name :: OccEnv (OccName,Fingerprint)
                    -> BinHandle -> Name -> IO  ()
        mk_put_name local_env bh name
           | isWiredInName name  =  putNameLiterally bh name
@@ -552,7 +583,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    -- interface into EPS, you will see a duplicate orphan instance.
 
    orphan_hash <- computeFingerprint (mk_put_name local_env)
-                      (map ifDFun orph_insts, orph_rules, orph_fis)
+                                     (map ifDFun orph_insts, orph_rules, orph_fis)
 
    -- the export list hash doesn't depend on the fingerprints of
    -- the Names it mentions, only the Names themselves, hence putNameLiterally.
@@ -568,7 +599,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 
    -- put the declarations in a canonical order, sorted by OccName
    let sorted_decls = Map.elems $ Map.fromList $
-                          [(ifName d, e) | e@(_, d) <- decls_w_hashes]
+                          [(getOccName d, e) | e@(_, d) <- decls_w_hashes]
 
    -- the flag hash depends on:
    --   - (some of) dflags
@@ -741,8 +772,8 @@ abiDecl :: IfaceDeclABI -> IfaceDecl
 abiDecl (_, decl, _) = decl
 
 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
-cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
-                         ifName (abiDecl abi2)
+cmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare`
+                         getOccName (abiDecl abi2)
 
 freeNamesDeclABI :: IfaceDeclABI -> NameSet
 freeNamesDeclABI (_mod, decl, extras) =
@@ -819,7 +850,7 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env decl
                         (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
                          map ifDFun         (lookupOccEnvL inst_env n))
                         (ann_fn n)
-                        (map (id_extras . ifConOcc) (visibleIfConDecls cons))
+                        (map (id_extras . occName . ifConName) (visibleIfConDecls cons))
       IfaceClass{ifSigs=sigs, ifATs=ats} ->
                      IfaceClassExtras (fix_fn n)
                         (map ifDFun $ (concatMap at_extras ats)
@@ -827,7 +858,7 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env decl
                            -- Include instances of the associated types
                            -- as well as instances of the class (Trac #5147)
                         (ann_fn n)
-                        [id_extras op | IfaceClassOp op _ _ <- sigs]
+                        [id_extras (getOccName op) | IfaceClassOp op _ _ <- sigs]
       IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n)
                                            (ann_fn n)
       IfaceFamily{} -> IfaceFamilyExtras (fix_fn n)
@@ -835,22 +866,14 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env decl
                         (ann_fn n)
       _other -> IfaceOtherDeclExtras
   where
-        n = ifName decl
+        n = getOccName decl
         id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn occ)
-        at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (ifName decl)
+        at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (getOccName decl)
 
 
 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
 
--- used when we want to fingerprint a structure without depending on the
--- fingerprints of external Names that it refers to.
-putNameLiterally :: BinHandle -> Name -> IO ()
-putNameLiterally bh name = ASSERT( isExternalName name )
-  do
-    put_ bh $! nameModule name
-    put_ bh $! nameOccName name
-
 {-
 -- for testing: use the md5sum command to generate fingerprints and
 -- compare the results against our built-in version.
@@ -1341,7 +1364,7 @@ idToIfaceDecl :: Id -> IfaceDecl
 -- We can't tidy it here, locally, because it may have
 -- free variables in its type or IdInfo
 idToIfaceDecl id
-  = IfaceId { ifName      = getOccName id,
+  = IfaceId { ifName      = getName id,
               ifType      = toIfaceType (idType id),
               ifIdDetails = toIfaceIdDetails (idDetails id),
               ifIdInfo    = toIfaceIdInfo (idInfo id) }
@@ -1349,7 +1372,7 @@ idToIfaceDecl id
 --------------------------
 dataConToIfaceDecl :: DataCon -> IfaceDecl
 dataConToIfaceDecl dataCon
-  = IfaceId { ifName      = getOccName dataCon,
+  = IfaceId { ifName      = getName dataCon,
               ifType      = toIfaceType (dataConUserType dataCon),
               ifIdDetails = IfVanillaId,
               ifIdInfo    = NoInfo }
@@ -1357,7 +1380,7 @@ dataConToIfaceDecl dataCon
 --------------------------
 patSynToIfaceDecl :: PatSyn -> IfaceDecl
 patSynToIfaceDecl ps
-  = IfacePatSyn { ifName          = getOccName . getName $ ps
+  = IfacePatSyn { ifName          = getName $ ps
                 , ifPatMatcher    = to_if_pr (patSynMatcher ps)
                 , ifPatBuilder    = fmap to_if_pr (patSynBuilder ps)
                 , ifPatIsInfix    = patSynIsInfix ps
@@ -1383,7 +1406,7 @@ coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
 -- conveniently be) built in tidy form
 coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
                                , co_ax_role = role })
- = IfaceAxiom { ifName       = name
+ = IfaceAxiom { ifName       = getName ax
               , ifTyCon      = toIfaceTyCon tycon
               , ifRole       = role
               , ifAxBranches = map (coAxBranchToIfaceBranch tycon
@@ -1391,7 +1414,6 @@ coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
                                    branch_list }
  where
    branch_list = fromBranches branches
-   name        = getOccName ax
 
 -- 2nd parameter is the list of branch LHSs, for conversion from incompatible branches
 -- to incompatible indices
@@ -1433,7 +1455,7 @@ tyConToIfaceDecl env tycon
 
   | Just syn_rhs <- synTyConRhs_maybe tycon
   = ( tc_env1
-    , IfaceSynonym { ifName    = getOccName tycon,
+    , IfaceSynonym { ifName    = getName tycon,
                      ifRoles   = tyConRoles tycon,
                      ifSynRhs  = if_syn_type syn_rhs,
                      ifBinders = if_binders,
@@ -1442,7 +1464,7 @@ tyConToIfaceDecl env tycon
 
   | Just fam_flav <- famTyConFlav_maybe tycon
   = ( tc_env1
-    , IfaceFamily { ifName    = getOccName tycon,
+    , IfaceFamily { ifName    = getName tycon,
                     ifResVar  = if_res_var,
                     ifFamFlav = to_if_fam_flav fam_flav,
                     ifBinders = if_binders,
@@ -1452,7 +1474,7 @@ tyConToIfaceDecl env tycon
 
   | isAlgTyCon tycon
   = ( tc_env1
-    , IfaceData { ifName    = getOccName tycon,
+    , IfaceData { ifName    = getName tycon,
                   ifBinders = if_binders,
                   ifResKind = if_res_kind,
                   ifCType   = tyConCType tycon,
@@ -1467,7 +1489,7 @@ tyConToIfaceDecl env tycon
   -- just about to pretty-print them, not because we are going
   -- to put them into interface files
   = ( env
-    , IfaceData { ifName       = getOccName tycon,
+    , IfaceData { ifName       = getName tycon,
                   ifBinders    = if_binders,
                   ifResKind    = if_res_kind,
                   ifCType      = Nothing,
@@ -1520,15 +1542,14 @@ tyConToIfaceDecl env tycon
         -- (Tuple declarations are not serialised into interface files.)
 
     ifaceConDecl data_con
-        = IfCon   { ifConOcc     = getOccName (dataConName data_con),
+        = IfCon   { ifConName    = dataConName data_con,
                     ifConInfix   = dataConIsInfix data_con,
                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
                     ifConExTvs   = map toIfaceForAllBndr ex_bndrs',
                     ifConEqSpec  = map (to_eq_spec . eqSpecPair) eq_spec,
                     ifConCtxt    = tidyToIfaceContext con_env2 theta,
                     ifConArgTys  = map (tidyToIfaceType con_env2) arg_tys,
-                    ifConFields  = map (nameOccName . flSelector)
-                                       (dataConFieldLabels data_con),
+                    ifConFields  = map flSelector (dataConFieldLabels data_con),
                     ifConStricts = map (toIfaceBang con_env2)
                                        (dataConImplBangs data_con),
                     ifConSrcStricts = map toIfaceSrcBang
@@ -1569,7 +1590,7 @@ classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
 classToIfaceDecl env clas
   = ( env1
     , IfaceClass { ifCtxt   = tidyToIfaceContext env1 sc_theta,
-                   ifName   = getOccName tycon,
+                   ifName   = getName tycon,
                    ifRoles  = tyConRoles (classTyCon clas),
                    ifBinders = toIfaceTyVarBinders tc_binders,
                    ifFDs    = map toIfaceFD clas_fds,
@@ -1591,7 +1612,7 @@ classToIfaceDecl env clas
 
     toIfaceClassOp (sel_id, def_meth)
         = ASSERT( sel_tyvars == binderVars tc_binders )
-          IfaceClassOp (getOccName sel_id)
+          IfaceClassOp (getName sel_id)
                        (tidyToIfaceType env1 op_ty)
                        (fmap toDmSpec def_meth)
         where
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 0794a9ee67..eba52e4890 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -263,7 +263,7 @@ typecheckIfacesForMerging mod ifaces tc_env_var =
     -- NB: Don't include dfuns here, because we don't want to
     -- serialize them out.  See Note [Bogus DFun renamings]
     let mk_decl_env decls
-            = mkOccEnv [ (ifName decl, decl)
+            = mkOccEnv [ (getOccName decl, decl)
                        | decl <- decls
                        , case decl of
                             IfaceId { ifIdDetails = IfDFunId } -> False -- exclude DFuns
@@ -420,10 +420,10 @@ mkSelfBootInfo iface mds
   = do -- NB: This is computed DIRECTLY from the ModIface rather
        -- than from the ModDetails, so that we can query 'sb_tcs'
        -- WITHOUT forcing the contents of the interface.
-       tcs <- mapM (lookupOrig (mi_module iface) . ifName)
-            . filter isIfaceTyCon
-            . map snd
-            $ mi_decls iface
+       let tcs = map ifName
+                 . filter isIfaceTyCon
+                 . map snd
+                 $ mi_decls iface
        return $ SelfBoot { sb_mds = mds
                          , sb_tcs = mkNameSet tcs }
   where
@@ -498,15 +498,14 @@ tc_iface_decl :: Maybe Class  -- ^ For associated type/data family declarations
               -> Bool         -- ^ True <=> discard IdInfo on IfaceId bindings
               -> IfaceDecl
               -> IfL TyThing
-tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
+tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type,
                                        ifIdDetails = details, ifIdInfo = info})
-  = do  { name <- lookupIfaceTop occ_name
-        ; ty <- tcIfaceType iface_type
+  = do  { ty <- tcIfaceType iface_type
         ; details <- tcIdDetails ty details
         ; info <- tcIdInfo ignore_prags name ty info
         ; return (AnId (mkGlobalId details name ty info)) }
 
-tc_iface_decl _ _ (IfaceData {ifName = occ_name,
+tc_iface_decl _ _ (IfaceData {ifName = tc_name,
                           ifCType = cType,
                           ifBinders = binders,
                           ifResKind = res_kind,
@@ -515,8 +514,7 @@ tc_iface_decl _ _ (IfaceData {ifName = occ_name,
                           ifCons = rdr_cons,
                           ifParent = mb_parent })
   = bindIfaceTyConBinders_AT binders $ \ binders' -> do
-    { tc_name <- lookupIfaceTop occ_name
-    ; res_kind' <- tcIfaceType res_kind
+    { res_kind' <- tcIfaceType res_kind
 
     ; tycon <- fixM $ \ tycon -> do
             { stupid_theta <- tcIfaceCtxt ctxt
@@ -539,14 +537,13 @@ tc_iface_decl _ _ (IfaceData {ifName = occ_name,
            ; lhs_tys <- tcIfaceTcArgs arg_tys
            ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
 
-tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name,
+tc_iface_decl _ _ (IfaceSynonym {ifName = tc_name,
                                       ifRoles = roles,
                                       ifSynRhs = rhs_ty,
                                       ifBinders = binders,
                                       ifResKind = res_kind })
    = bindIfaceTyConBinders_AT binders $ \ binders' -> do
-     { tc_name  <- lookupIfaceTop occ_name
-     ; res_kind' <- tcIfaceType res_kind     -- Note [Synonym kind loop]
+     { res_kind' <- tcIfaceType res_kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
                    tcIfaceType rhs_ty
      ; let tycon = mkSynonymTyCon tc_name binders' res_kind' roles rhs
@@ -554,14 +551,13 @@ tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name,
    where
      mk_doc n = text "Type synonym" <+> ppr n
 
-tc_iface_decl parent _ (IfaceFamily {ifName = occ_name,
+tc_iface_decl parent _ (IfaceFamily {ifName = tc_name,
                                      ifFamFlav = fam_flav,
                                      ifBinders = binders,
                                      ifResKind = res_kind,
                                      ifResVar = res, ifFamInj = inj })
    = bindIfaceTyConBinders_AT binders $ \ binders' -> do
-     { tc_name   <- lookupIfaceTop occ_name
-     ; res_kind' <- tcIfaceType res_kind    -- Note [Synonym kind loop]
+     { res_kind' <- tcIfaceType res_kind    -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
                    tc_fam_flav tc_name fam_flav
      ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
@@ -585,7 +581,7 @@ tc_iface_decl parent _ (IfaceFamily {ifName = occ_name,
                     (text "IfaceBuiltInSynFamTyCon in interface file")
 
 tc_iface_decl _parent ignore_prags
-            (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
+            (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_name,
                          ifRoles = roles,
                          ifBinders = binders,
                          ifFDs = rdr_fds,
@@ -594,17 +590,16 @@ tc_iface_decl _parent ignore_prags
 -- ToDo: in hs-boot files we should really treat abstract classes specially,
 --       as we do abstract tycons
   = bindIfaceTyConBinders binders $ \ binders' -> do
-    { tc_name <- lookupIfaceTop tc_occ
-    ; traceIf (text "tc-iface-class1" <+> ppr tc_occ)
+    { traceIf (text "tc-iface-class1" <+> ppr tc_name)
     ; ctxt <- mapM tc_sc rdr_ctxt
-    ; traceIf (text "tc-iface-class2" <+> ppr tc_occ)
+    ; traceIf (text "tc-iface-class2" <+> ppr tc_name)
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
-    ; traceIf (text "tc-iface-class3" <+> ppr tc_occ)
+    ; traceIf (text "tc-iface-class3" <+> ppr tc_name)
     ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats
-              ; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
+              ; traceIf (text "tc-iface-class4" <+> ppr tc_name)
               ; buildClass tc_name binders' roles ctxt fds ats sigs mindef }
     ; return (ATyCon (classTyCon cls)) }
   where
@@ -618,9 +613,8 @@ tc_iface_decl _parent ignore_prags
         -- so we must not pull on T too eagerly.  See Trac #5970
 
    tc_sig :: IfaceClassOp -> IfL TcMethInfo
-   tc_sig (IfaceClassOp occ rdr_ty dm)
-     = do { op_name <- lookupIfaceTop occ
-          ; let doc = mk_op_doc op_name rdr_ty
+   tc_sig (IfaceClassOp op_name rdr_ty dm)
+     = do { let doc = mk_op_doc op_name rdr_ty
           ; op_ty <- forkM (doc <+> text "ty") $ tcIfaceType rdr_ty
                 -- Must be done lazily for just the same reason as the
                 -- type of a data con; to avoid sucking in types that
@@ -659,10 +653,9 @@ tc_iface_decl _parent ignore_prags
                            ; tvs2' <- mapM tcIfaceTyVar tvs2
                            ; return (tvs1', tvs2') }
 
-tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
+tc_iface_decl _ _ (IfaceAxiom { ifName = tc_name, ifTyCon = tc
                               , ifAxBranches = branches, ifRole = role })
-  = do { tc_name     <- lookupIfaceTop ax_occ
-       ; tc_tycon    <- tcIfaceTyCon tc
+  = do { tc_tycon    <- tcIfaceTyCon tc
        ; tc_branches <- tc_ax_branches branches
        ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
                              , co_ax_name     = tc_name
@@ -672,7 +665,7 @@ tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
                              , co_ax_implicit = False }
        ; return (ACoAxiom axiom) }
 
-tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
+tc_iface_decl _ _ (IfacePatSyn{ ifName = name
                               , ifPatMatcher = if_matcher
                               , ifPatBuilder = if_builder
                               , ifPatIsInfix = is_infix
@@ -683,8 +676,7 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
                               , ifPatArgs = args
                               , ifPatTy = pat_ty
                               , ifFieldLabels = field_labels })
-  = do { name <- lookupIfaceTop occ_name
-       ; traceIf (text "tc_iface_decl" <+> ppr name)
+  = do { traceIf (text "tc_iface_decl" <+> ppr name)
        ; matcher <- tc_pr if_matcher
        ; builder <- fmapMaybeM tc_pr if_builder
        ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs -> do
@@ -744,15 +736,15 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
 
     tc_con_decl field_lbls (IfCon { ifConInfix = is_infix,
                          ifConExTvs = ex_bndrs,
-                         ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
+                         ifConName = dc_name,
+                         ifConCtxt = ctxt, ifConEqSpec = spec,
                          ifConArgTys = args, ifConFields = my_lbls,
                          ifConStricts = if_stricts,
                          ifConSrcStricts = if_src_stricts})
      = -- Universally-quantified tyvars are shared with
        -- parent TyCon, and are alrady in scope
        bindIfaceForAllBndrs ex_bndrs    $ \ ex_tv_bndrs -> do
-        { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
-        ; dc_name  <- lookupIfaceTop occ
+        { traceIf (text "Start interface-file tc_con_decl" <+> ppr dc_name)
 
         -- Read the context and argument types, but lazily for two reasons
         -- (a) to avoid looking tugging on a recursive use of
@@ -771,9 +763,9 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
         -- Look up the field labels for this constructor; note that
         -- they should be in the same order as my_lbls!
         ; let lbl_names = map find_lbl my_lbls
-              find_lbl x = case find (\ fl -> nameOccName (flSelector fl) == x) field_lbls of
+              find_lbl x = case find (\ fl -> flSelector fl == x) field_lbls of
                              Just fl -> fl
-                             Nothing -> error $ "find_lbl missing " ++ occNameString x
+                             Nothing -> error $ "find_lbl missing " ++ occNameString (occName x)
 
         -- Remember, tycon is the representation tycon
         ; let orig_res_ty = mkFamilyTyConApp tycon
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index ae6ad7d068..141f59f299 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -98,7 +98,6 @@ import ConLike
 import Control.Concurrent
 #endif
 
-import THNames          ( templateHaskellNames )
 import Module
 import Packages
 import RdrName
@@ -111,7 +110,7 @@ import SrcLoc
 import TcRnDriver
 import TcIface          ( typecheckIface )
 import TcRnMonad
-import IfaceEnv         ( initNameCache )
+import NameCache        ( initNameCache )
 import LoadIface        ( ifaceStats, initExternalPackageState )
 import PrelInfo
 import MkIface
@@ -144,7 +143,6 @@ import DynFlags
 import ErrUtils
 
 import Outputable
-import UniqFM
 import NameEnv
 import HscStats         ( ppSourceStats )
 import HscTypes
@@ -178,7 +176,7 @@ newHscEnv :: DynFlags -> IO HscEnv
 newHscEnv dflags = do
     eps_var <- newIORef initExternalPackageState
     us      <- mkSplitUniqSupply 'r'
-    nc_var  <- newIORef (initNameCache us allKnownKeyNames)
+    nc_var  <- newIORef (initNameCache us knownKeyNames)
     fc_var  <- newIORef emptyInstalledModuleEnv
 #ifdef GHCI
     iserv_mvar <- newMVar Nothing
@@ -197,39 +195,6 @@ newHscEnv dflags = do
 #endif
                   }
 
-
-allKnownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
-allKnownKeyNames                -- where templateHaskellNames are defined
-  | debugIsOn
-  , not (isNullUFM badNamesEnv)
-  = panic ("badAllKnownKeyNames:\n" ++ badNamesStr)
-       -- NB: We can't use ppr here, because this is sometimes evaluated in a
-       -- context where there are no DynFlags available, leading to a cryptic
-       -- "<<details unavailable>>" error. (This seems to happen only in the
-       -- stage 2 compiler, for reasons I [Richard] have no clue of.)
-
-  | otherwise
-  = all_names
-  where
-    all_names = knownKeyNames
-                ++ templateHaskellNames
-
-    namesEnv      = foldl (\m n -> extendNameEnv_Acc (:) singleton m n n)
-                          emptyUFM all_names
-    badNamesEnv   = filterNameEnv (\ns -> length ns > 1) namesEnv
-    badNamesPairs = nonDetUFMToList badNamesEnv
-      -- It's OK to use nonDetUFMToList here because the ordering only affects
-      -- the message when we get a panic
-    badNamesStrs  = map pairToStr badNamesPairs
-    badNamesStr   = unlines badNamesStrs
-
-    pairToStr (uniq, ns) = "        " ++
-                           show uniq ++
-                           ": [" ++
-                           intercalate ", " (map (occNameString . nameOccName) ns) ++
-                           "]"
-
-
 -- -----------------------------------------------------------------------------
 
 getWarnings :: Hsc WarningMessages
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index f1c253f414..b5f86db4e6 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -101,7 +101,7 @@ module HscTypes (
         -- * Information on imports and exports
         WhetherHasOrphans, IsBootInterface, Usage(..),
         Dependencies(..), noDependencies,
-        NameCache(..), OrigNameCache, updNameCacheIO,
+        updNameCacheIO,
         IfaceExport,
 
         -- * Warnings
@@ -151,7 +151,7 @@ import Avail
 import Module
 import InstEnv          ( InstEnv, ClsInst, identicalClsInstHead )
 import FamInstEnv
-import CoreSyn          ( CoreProgram, RuleBase )
+import CoreSyn          ( CoreProgram, RuleBase, CoreRule, CoreVect )
 import Name
 import NameEnv
 import NameSet
@@ -178,13 +178,11 @@ import DynFlags
 import DriverPhases     ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
 import BasicTypes
 import IfaceSyn
-import CoreSyn          ( CoreRule, CoreVect )
 import Maybes
 import Outputable
 import SrcLoc
 import Unique
 import UniqDFM
-import UniqSupply
 import FastString
 import StringBuffer     ( StringBuffer )
 import Fingerprint
@@ -192,6 +190,7 @@ import MonadUtils
 import Bag
 import Binary
 import ErrUtils
+import NameCache
 import Platform
 import Util
 import UniqDSet
@@ -2510,25 +2509,12 @@ interface file); so we give it 'noSrcLoc' then.  Later, when we find
 its binding site, we fix it up.
 -}
 
--- | The NameCache makes sure that there is just one Unique assigned for
--- each original name; i.e. (module-name, occ-name) pair and provides
--- something of a lookup mechanism for those names.
-data NameCache
- = NameCache {  nsUniqs :: !UniqSupply,
-                -- ^ Supply of uniques
-                nsNames :: !OrigNameCache
-                -- ^ Ensures that one original name gets one unique
-   }
-
 updNameCacheIO :: HscEnv
                -> (NameCache -> (NameCache, c))  -- The updating function
                -> IO c
 updNameCacheIO hsc_env upd_fn
   = atomicModifyIORef' (hsc_NC hsc_env) upd_fn
 
--- | Per-module cache of original 'OccName's given 'Name's
-type OrigNameCache   = ModuleEnv (OccEnv Name)
-
 mkSOName :: Platform -> FilePath -> FilePath
 mkSOName platform root
     = case platformOS platform of
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index 5bd94e3cae..e59a3896f3 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -43,6 +43,7 @@ import BasicTypes
 import Name hiding (varName)
 import NameSet
 import NameEnv
+import NameCache
 import Avail
 import IfaceEnv
 import TcEnv
diff --git a/compiler/prelude/KnownUniques.hs b/compiler/prelude/KnownUniques.hs
new file mode 100644
index 0000000000..2dc6f8388d
--- /dev/null
+++ b/compiler/prelude/KnownUniques.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE CPP #-}
+
+-- | This is where we define a mapping from Uniques to their associated
+-- known-key Names for things associated with tuples and sums. We use this
+-- mapping while deserializing known-key Names in interface file symbol tables,
+-- which are encoded as their Unique. See Note [Symbol table representation of
+-- names] for details.
+--
+
+module KnownUniques
+    ( -- * Looking up known-key names
+      knownUniqueName
+
+      -- * Getting the 'Unique's of 'Name's
+      -- ** Anonymous sums
+    , mkSumTyConUnique
+    , mkSumDataConUnique
+      -- ** Tuples
+      -- *** Vanilla
+    , mkTupleTyConUnique
+    , mkTupleDataConUnique
+      -- *** Constraint
+    , mkCTupleTyConUnique
+    , mkCTupleDataConUnique
+    ) where
+
+#include "HsVersions.h"
+
+import TysWiredIn
+import TyCon
+import DataCon
+import Id
+import BasicTypes
+import Outputable
+import Unique
+import Name
+import Util
+
+import Data.Bits
+import Data.Maybe
+
+-- | Get the 'Name' associated with a known-key 'Unique'.
+knownUniqueName :: Unique -> Maybe Name
+knownUniqueName u =
+    case tag of
+      'z' -> Just $ getUnboxedSumName n
+      '4' -> Just $ getTupleTyConName Boxed n
+      '5' -> Just $ getTupleTyConName Unboxed n
+      '7' -> Just $ getTupleDataConName Boxed n
+      '8' -> Just $ getTupleDataConName Unboxed n
+      'k' -> Just $ getCTupleTyConName n
+      'm' -> Just $ getCTupleDataConUnique n
+      _   -> Nothing
+  where
+    (tag, n) = unpkUnique u
+
+--------------------------------------------------
+-- Anonymous sums
+--
+-- Sum arities start from 2. The encoding is a bit funny: we break up the
+-- integral part into bitfields for the arity and alternative index (which is
+-- taken to be 0xff in the case of the TyCon)
+--
+-- TyCon for sum of arity k:
+--   00000000 kkkkkkkk 11111111
+-- DataCon for sum of arity k and alternative n (zero-based):
+--   00000000 kkkkkkkk nnnnnnnn
+
+mkSumTyConUnique :: Arity -> Unique
+mkSumTyConUnique arity =
+    ASSERT(arity < 0xff)
+    mkUnique 'z' (arity `shiftL` 8 .|. 0xff)
+
+mkSumDataConUnique :: ConTagZ -> Arity -> Unique
+mkSumDataConUnique alt arity
+  | alt >= arity
+  = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
+  | otherwise
+  = mkUnique 'z' (arity `shiftL` 8 + alt) {- skip the tycon -}
+
+getUnboxedSumName :: Int -> Name
+getUnboxedSumName n =
+    case n .&. 0xff of
+      0xff -> tyConName $ sumTyCon arity
+      alt  -> dataConName $ sumDataCon (alt + 1) arity
+  where arity = n `shiftR` 8
+
+-- Note [Uniques for tuple type and data constructors]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Wired-in type constructor keys occupy *two* slots:
+--    * u: the TyCon itself
+--    * u+1: the TyConRepName of the TyCon
+--
+-- Wired-in tuple data constructor keys occupy *three* slots:
+--    * u: the DataCon itself
+--    * u+1: its worker Id
+--    * u+2: the TyConRepName of the promoted TyCon
+
+--------------------------------------------------
+-- Constraint tuples
+
+mkCTupleTyConUnique :: Arity -> Unique
+mkCTupleTyConUnique a = mkUnique 'k' (2*a)
+
+mkCTupleDataConUnique :: Arity -> Unique
+mkCTupleDataConUnique a = mkUnique 'm' (3*a)
+
+getCTupleTyConName :: Int -> Name
+getCTupleTyConName n =
+    case n `divMod` 2 of
+      (arity, 0) -> cTupleTyConName arity
+      (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity
+      _          -> panic "getCTupleTyConName: impossible"
+
+getCTupleDataConUnique :: Int -> Name
+getCTupleDataConUnique n =
+    case n `divMod` 3 of
+      (arity,  0) -> cTupleDataConName arity
+      (_arity, 1) -> panic "getCTupleDataConName: no worker"
+      (arity,  2) -> mkPrelTyConRepName $ cTupleDataConName arity
+      _           -> panic "getCTupleDataConName: impossible"
+
+--------------------------------------------------
+-- Normal tuples
+
+mkTupleDataConUnique :: Boxity -> Arity -> Unique
+mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- may be used in C labels
+mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)
+
+mkTupleTyConUnique :: Boxity -> Arity -> Unique
+mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)
+mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)
+
+getTupleTyConName :: Boxity -> Int -> Name
+getTupleTyConName boxity n =
+    case n `divMod` 2 of
+      (arity, 0) -> tyConName $ tupleTyCon boxity arity
+      (arity, 1) -> fromMaybe (panic "getTupleTyConName")
+                    $ tyConRepName_maybe $ tupleTyCon boxity arity
+      _          -> panic "getTupleTyConName: impossible"
+
+getTupleDataConName :: Boxity -> Int -> Name
+getTupleDataConName boxity n =
+    case n `divMod` 3 of
+      (arity, 0) -> dataConName $ tupleDataCon boxity arity
+      (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity
+      (arity, 2) -> fromMaybe (panic "getTupleDataCon")
+                    $ tyConRepName_maybe $ promotedTupleDataCon boxity arity
+      _          -> panic "getTupleDataConName: impossible"
diff --git a/compiler/prelude/KnownUniques.hs-boot b/compiler/prelude/KnownUniques.hs-boot
new file mode 100644
index 0000000000..eeb478526d
--- /dev/null
+++ b/compiler/prelude/KnownUniques.hs-boot
@@ -0,0 +1,17 @@
+module KnownUniques where
+
+import Unique
+import Name
+import BasicTypes
+
+-- Needed by TysWiredIn
+knownUniqueName :: Unique -> Maybe Name
+
+mkSumTyConUnique :: Arity -> Unique
+mkSumDataConUnique :: ConTagZ -> Arity -> Unique
+
+mkCTupleTyConUnique :: Arity -> Unique
+mkCTupleDataConUnique :: Arity -> Unique
+
+mkTupleTyConUnique :: Boxity -> Arity -> Unique
+mkTupleDataConUnique :: Boxity -> Arity -> Unique
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index 52493b40f5..59a998093a 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -1,31 +1,54 @@
 {-
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 
-\section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
 -}
 
 {-# LANGUAGE CPP #-}
+
+-- | The @PrelInfo@ interface to the compiler's prelude knowledge.
+--
+-- This module serves as the central gathering point for names which the
+-- compiler knows something about. This includes functions for,
+--
+--  * discerning whether a 'Name' is known-key
+--
+--  * given a 'Unique', looking up its corresponding known-key 'Name'
+--
+-- See Note [Known-key names] and Note [About wired-in things] for information
+-- about the two types of prelude things in GHC.
+--
 module PrelInfo (
+        -- * Known-key names
+        isKnownKeyName,
+        lookupKnownKeyName,
+
+        -- ** Internal use
+        -- | 'knownKeyNames' is exported to seed the original name cache only;
+        -- if you find yourself wanting to look at it you might consider using
+        -- 'lookupKnownKeyName' or 'isKnownKeyName'.
+        knownKeyNames,
+
+        -- * Miscellaneous
         wiredInIds, ghcPrimIds,
         primOpRules, builtinRules,
 
         ghcPrimExports,
-        knownKeyNames,
         primOpId,
 
-        -- Random other things
+        -- * Random other things
         maybeCharLikeCon, maybeIntLikeCon,
 
-        -- Class categories
+        -- * Class categories
         isNumericClass, isStandardClass
 
     ) where
 
 #include "HsVersions.h"
 
-import Constants        ( mAX_TUPLE_SIZE )
-import BasicTypes       ( Boxity(..) )
+import KnownUniques
+
 import ConLike          ( ConLike(..) )
+import THNames          ( templateHaskellNames )
 import PrelNames
 import PrelRules
 import Avail
@@ -33,16 +56,22 @@ import PrimOp
 import DataCon
 import Id
 import Name
+import NameEnv
 import MkId
 import TysPrim
 import TysWiredIn
 import HscTypes
 import Class
 import TyCon
+import UniqFM
 import Util
+import Panic
 import {-# SOURCE #-} TcTypeNats ( typeNatTyCons )
 
+import Control.Applicative ((<|>))
+import Data.List        ( intercalate )
 import Data.Array
+import Data.Maybe
 
 {-
 ************************************************************************
@@ -51,8 +80,8 @@ import Data.Array
 *                                                                      *
 ************************************************************************
 
-Notes about wired in things
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [About wired-in things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * Wired-in things are Ids\/TyCons that are completely known to the compiler.
   They are global values in GHC, (e.g.  listTyCon :: TyCon).
 
@@ -61,6 +90,7 @@ Notes about wired in things
   (E.g. listTyConName contains listTyCon.
 
 * The name cache is initialised with (the names of) all wired-in things
+  (except tuples and sums; see Note [Known-])
 
 * The type environment itself contains no wired in things. The type
   checker sees if the Name is wired in before looking up the name in
@@ -77,47 +107,91 @@ knownKeyNames :: [Name]
 -- you get a Name with the correct known key
 -- (See Note [Known-key names] in PrelNames)
 knownKeyNames
-  = concat [ tycon_kk_names funTyCon
-           , concatMap tycon_kk_names primTyCons
-
-           , concatMap tycon_kk_names wiredInTyCons
-             -- Does not include tuples
-
-           , concatMap tycon_kk_names typeNatTyCons
-
-           , concatMap (tycon_kk_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE]  -- Yuk
-
-           , cTupleTyConNames
-             -- Constraint tuples are known-key but not wired-in
-             -- They can't show up in source code, but can appear
-             -- in interface files
-
-           , map idName wiredInIds
-           , map (idName . primOpId) allThePrimOps
-           , basicKnownKeyNames ]
-
+  | debugIsOn
+  , Just badNamesStr <- knownKeyNamesOkay all_names
+  = panic ("badAllKnownKeyNames:\n" ++ badNamesStr)
+       -- NB: We can't use ppr here, because this is sometimes evaluated in a
+       -- context where there are no DynFlags available, leading to a cryptic
+       -- "<<details unavailable>>" error. (This seems to happen only in the
+       -- stage 2 compiler, for reasons I [Richard] have no clue of.)
+  | otherwise
+  = all_names
+  where
+    all_names =
+      concat [ wired_tycon_kk_names funTyCon
+            , concatMap wired_tycon_kk_names primTyCons
+
+            , concatMap wired_tycon_kk_names wiredInTyCons
+              -- Does not include tuples
+
+            , concatMap wired_tycon_kk_names typeNatTyCons
+
+            , map idName wiredInIds
+            , map (idName . primOpId) allThePrimOps
+            , basicKnownKeyNames
+            , templateHaskellNames
+            ]
+    -- All of the names associated with a wired-in TyCon.
+    -- This includes the TyCon itself, its DataCons and promoted TyCons.
+    wired_tycon_kk_names :: TyCon -> [Name]
+    wired_tycon_kk_names tc =
+        tyConName tc : (rep_names tc ++ implicits)
+      where implicits = concatMap thing_kk_names (implicitTyConThings tc)
+
+    wired_datacon_kk_names :: DataCon -> [Name]
+    wired_datacon_kk_names dc =
+      dataConName dc : rep_names (promoteDataCon dc)
+
+    thing_kk_names :: TyThing -> [Name]
+    thing_kk_names (ATyCon tc)                 = wired_tycon_kk_names tc
+    thing_kk_names (AConLike (RealDataCon dc)) = wired_datacon_kk_names dc
+    thing_kk_names thing                       = [getName thing]
+
+    -- The TyConRepName for a known-key TyCon has a known key,
+    -- but isn't itself an implicit thing.  Yurgh.
+    -- NB: if any of the wired-in TyCons had record fields, the record
+    --     field names would be in a similar situation.  Ditto class ops.
+    --     But it happens that there aren't any
+    rep_names tc = case tyConRepName_maybe tc of
+                        Just n  -> [n]
+                        Nothing -> []
+
+-- | Check the known-key names list of consistency.
+knownKeyNamesOkay :: [Name] -> Maybe String
+knownKeyNamesOkay all_names
+  | null badNamesPairs
+  = Nothing
+  | otherwise
+  = Just badNamesStr
   where
-  -- All of the names associated with a known-key thing.
-  -- This includes TyCons, DataCons and promoted TyCons.
-  tycon_kk_names :: TyCon -> [Name]
-  tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc))
-
-  datacon_kk_names dc
-   = dataConName dc : rep_names (promoteDataCon dc)
-
-  thing_kk_names :: TyThing -> [Name]
-  thing_kk_names (ATyCon tc)                 = tycon_kk_names tc
-  thing_kk_names (AConLike (RealDataCon dc)) = datacon_kk_names dc
-  thing_kk_names thing                       = [getName thing]
-
-  -- The TyConRepName for a known-key TyCon has a known key,
-  -- but isn't itself an implicit thing.  Yurgh.
-  -- NB: if any of the wired-in TyCons had record fields, the record
-  --     field names would be in a similar situation.  Ditto class ops.
-  --     But it happens that there aren't any
-  rep_names tc = case tyConRepName_maybe tc of
-                       Just n  -> [n]
-                       Nothing -> []
+    namesEnv      = foldl (\m n -> extendNameEnv_Acc (:) singleton m n n)
+                          emptyUFM all_names
+    badNamesEnv   = filterNameEnv (\ns -> length ns > 1) namesEnv
+    badNamesPairs = nonDetUFMToList badNamesEnv
+      -- It's OK to use nonDetUFMToList here because the ordering only affects
+      -- the message when we get a panic
+    badNamesStrs  = map pairToStr badNamesPairs
+    badNamesStr   = unlines badNamesStrs
+
+    pairToStr (uniq, ns) = "        " ++
+                           show uniq ++
+                           ": [" ++
+                           intercalate ", " (map (occNameString . nameOccName) ns) ++
+                           "]"
+
+-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
+-- known-key thing.
+lookupKnownKeyName :: Unique -> Maybe Name
+lookupKnownKeyName u =
+    knownUniqueName u <|> lookupUFM knownKeysMap u
+
+-- | Is a 'Name' known-key?
+isKnownKeyName :: Name -> Bool
+isKnownKeyName n =
+    isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
+
+knownKeysMap :: UniqFM Name
+knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ]
 
 {-
 We let a lot of "non-standard" values be visible, so that we can make
@@ -142,7 +216,7 @@ primOpId op = primOpIds ! primOpTag op
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Export lists for pseudo-modules (GHC.Prim)}
+            Export lists for pseudo-modules (GHC.Prim)
 *                                                                      *
 ************************************************************************
 
@@ -160,7 +234,7 @@ ghcPrimExports
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Built-in keys}
+            Built-in keys
 *                                                                      *
 ************************************************************************
 
@@ -174,7 +248,7 @@ maybeIntLikeCon  con = con `hasKey` intDataConKey
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Class predicates}
+            Class predicates
 *                                                                      *
 ************************************************************************
 -}
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 558619a9db..41c9e36304 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -73,33 +73,44 @@ This is accomplished through a combination of mechanisms:
      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), we have
-     to be extra careful. Because there are an infinite number of
+  3. For "infinite families" of known-key names (i.e. tuples and sums), 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 OrigNameCache. Instead, we have to
-     rely on never having to look them up in that cache.
+     rely on never having to look them up in that cache. See
+     Note [Infinite families of known-key names] for details.
 
-     This is accomplished through a variety of mechanisms:
 
-       a) The parser recognises them specially and generates an
-          Exact Name (hence not looked up in the orig-name cache)
+Note [Infinite families of known-key names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-       b) 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.
+Infinite families of known-key things (e.g. tuples and sums) pose a tricky
+problem: we can't add them to the knownKeyNames finite map which we use to
+ensure that, e.g., a reference to (,) gets assigned the right unique (if this
+doesn't sound familiar see Note [Known-key names] above).
 
-       Most of the infinite families cannot occur in source code,
-       so mechanisms (a,b) 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.
+We instead handle tuples and sums separately from the "vanilla" known-key
+things,
 
-       c) IfaceEnv.lookupOrigNameCache uses isBuiltInOcc_maybe to map
-          built-in syntax directly onto the corresponding name, rather
-          than trying to find it in the original-name cache.
+  a) The parser recognises them specially and generates an Exact Name (hence not
+     looked up in the orig-name cache)
 
-          See also Note [Built-in syntax and the OrigNameCache]
+  b) 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. See Note [Symbol table
+     representation of names] in BinIface and Note [How tuples work] in
+     TysWiredIn.
+
+Most of the infinite families cannot occur in source code, so mechanisms (a) and (b)
+suffice 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. For those things that *can* appear in source programs,
+
+  c) IfaceEnv.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax
+     directly onto the corresponding name, rather than trying to find it in the
+     original-name cache.
+
+     See also Note [Built-in syntax and the OrigNameCache]
 -}
 
 {-# LANGUAGE CPP #-}
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index b334967009..a954f0472f 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -73,7 +73,9 @@ module TysWiredIn (
         unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
         pairTyCon,
         unboxedUnitTyCon, unboxedUnitDataCon,
+        -- ** Constraint tuples
         cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
+        cTupleDataConName, cTupleDataConNames,
 
         -- * Any
         anyTyCon, anyTy, anyTypeOfKind,
@@ -127,6 +129,7 @@ import {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId )
 -- friends:
 import PrelNames
 import TysPrim
+import {-# SOURCE #-} KnownUniques
 
 -- others:
 import CoAxiom
@@ -195,12 +198,13 @@ names in PrelNames, so they use wTcQual, wDataQual, etc
 -- See also Note [Known-key names]
 wiredInTyCons :: [TyCon]
 
-wiredInTyCons = [ unitTyCon     -- Not treated like other tuples, because
-                                -- it's defined in GHC.Base, and there's only
-                                -- one of it.  We put it in wiredInTyCons so
-                                -- that it'll pre-populate the name cache, so
-                                -- the special case in lookupOrigNameCache
-                                -- doesn't need to look out for it
+wiredInTyCons = [ -- Units are not treated like other tuples, because then
+                  -- are defined in GHC.Base, and there's only a few of them. We
+                  -- put them in wiredInTyCons so that they will pre-populate
+                  -- the name cache, so the parser in isBuiltInOcc_maybe doesn't
+                  -- need to look out for them.
+                  unitTyCon
+                , unboxedUnitTyCon
                 , anyTyCon
                 , boolTyCon
                 , charTyCon
@@ -523,15 +527,21 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys
 
     no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict
 
-    modu     = ASSERT( isExternalName dc_name )
-               nameModule dc_name
-    dc_occ   = nameOccName dc_name
-    wrk_occ  = mkDataConWorkerOcc dc_occ
-    wrk_name = mkWiredInName modu wrk_occ wrk_key
-                             (AnId (dataConWorkId data_con)) UserSyntax
+    wrk_name = mkDataConWorkerName data_con wrk_key
 
     prom_info = mkPrelTyConRepName dc_name
 
+mkDataConWorkerName :: DataCon -> Unique -> Name
+mkDataConWorkerName data_con wrk_key =
+    mkWiredInName modu wrk_occ wrk_key
+                  (AnId (dataConWorkId data_con)) UserSyntax
+  where
+    modu     = ASSERT( isExternalName dc_name )
+               nameModule dc_name
+    dc_name = dataConName data_con
+    dc_occ  = nameOccName dc_name
+    wrk_occ = mkDataConWorkerOcc dc_occ
+
 -- used for RuntimeRep and friends
 pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
 pcSpecialDataCon dc_name arg_tys tycon rri
@@ -623,6 +633,11 @@ Note [How tuples work]  See also Note [Known-key names] in PrelNames
   between BoxedTuple and ConstraintTuple (same OccName!), so tuples
   are not serialised into interface files using OccNames at all.
 
+* Serialization to interface files works via the usual mechanism for known-key
+  things: instead of serializing the OccName we just serialize the key. During
+  deserialization we lookup the Name associated with the unique with the logic
+  in KnownUniques. See Note [Symbol table representation of names] for details.
+
 Note [One-tuples]
 ~~~~~~~~~~~~~~~~~
 GHC supports both boxed and unboxed one-tuples:
@@ -650,27 +665,51 @@ decl in GHC.Classes, so I think this part may not work properly. But
 it's unused I think.
 -}
 
--- | Built in syntax isn't "in scope" so these OccNames map to wired-in Names
+-- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names
 -- with BuiltInSyntax. However, this should only be necessary while resolving
 -- names produced by Template Haskell splices since we take care to encode
 -- built-in syntax names specially in interface files. See
 -- Note [Symbol table representation of names].
+--
+-- Moreover, there is no need to include names of things that the user can't
+-- write (e.g. type representation bindings like $tc(,,,)).
 isBuiltInOcc_maybe :: OccName -> Maybe Name
 isBuiltInOcc_maybe occ =
     case name of
       "[]" -> Just $ choose_ns listTyConName nilDataConName
       ":"    -> Just consDataConName
+
       "[::]" -> Just parrTyConName
+
+      -- boxed tuple data/tycon
       "()"    -> Just $ tup_name Boxed 0
-      "(##)"  -> Just $ tup_name Unboxed 0
       _ | Just rest <- "(" `stripPrefix` name
         , (commas, rest') <- BS.span (==',') rest
         , ")" <- rest'
              -> Just $ tup_name Boxed (1+BS.length commas)
+
+      -- unboxed tuple data/tycon
+      "(##)"  -> Just $ tup_name Unboxed 0
       _ | Just rest <- "(#" `stripPrefix` name
         , (commas, rest') <- BS.span (==',') rest
         , "#)" <- rest'
              -> Just $ tup_name Unboxed (1+BS.length commas)
+
+      -- unboxed sum tycon
+      _ | Just rest <- "(#" `stripPrefix` name
+        , (pipes, rest') <- BS.span (=='|') rest
+        , "#)" <- rest'
+             -> Just $ tyConName $ sumTyCon (1+BS.length pipes)
+
+      -- unboxed sum datacon
+      _ | Just rest <- "(#" `stripPrefix` name
+        , (pipes1, rest') <- BS.span (=='|') rest
+        , Just rest'' <- "_" `stripPrefix` rest'
+        , (pipes2, rest''') <- BS.span (=='|') rest''
+        , "#)" <- rest'''
+             -> let arity = BS.length pipes1 + BS.length pipes2
+                    alt = BS.length pipes1 + 1
+                in Just $ dataConName $ sumDataCon alt arity
       _ -> Nothing
   where
     -- TODO: Drop when bytestring 0.10.8 can be assumed
@@ -725,7 +764,6 @@ cTupleTyConName :: Arity -> Name
 cTupleTyConName arity
   = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES
                    (mkCTupleOcc tcName arity) noSrcSpan
-  -- The corresponding DataCon does not have a known-key name
 
 cTupleTyConNames :: [Name]
 cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
@@ -740,6 +778,14 @@ isCTupleTyConName n
    nameModule n == gHC_CLASSES
    && n `elemNameSet` cTupleTyConNameSet
 
+cTupleDataConName :: Arity -> Name
+cTupleDataConName arity
+  = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES
+                   (mkCTupleOcc dataName arity) noSrcSpan
+
+cTupleDataConNames :: [Name]
+cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE])
+
 tupleTyCon :: Boxity -> Arity -> TyCon
 tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially
 tupleTyCon Boxed   i = fst (boxedTupleArr   ! i)
diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs
index 853f5be149..a12607bd84 100644
--- a/compiler/simplCore/CoreMonad.hs
+++ b/compiler/simplCore/CoreMonad.hs
@@ -79,6 +79,7 @@ import Maybes
 import UniqSupply
 import UniqFM       ( UniqFM, mapUFM, filterUFM )
 import MonadUtils
+import NameCache
 import SrcLoc
 import ListSetOps       ( runs )
 import Data.List
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 8b95c1b876..7b0d34d871 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -816,8 +816,17 @@ checkBootDeclM :: Bool  -- ^ True <=> an hs-boot file (could also be a sig)
                -> TyThing -> TyThing -> TcM ()
 checkBootDeclM is_boot boot_thing real_thing
   = whenIsJust (checkBootDecl is_boot boot_thing real_thing) $ \ err ->
-       addErrAt (nameSrcSpan (getName boot_thing))
+       addErrAt span
                 (bootMisMatch is_boot err real_thing boot_thing)
+  where
+    -- Here we use the span of the boot thing or, if it doesn't have a sensible
+    -- span, that of the real thing,
+    span
+      | let span = nameSrcSpan (getName boot_thing)
+      , isGoodSrcSpan span
+      = span
+      | otherwise
+      = nameSrcSpan (getName real_thing)
 
 -- | Compares the two things for equivalence between boot-file and normal
 -- code. Returns @Nothing@ on success or @Just "some helpful info for user"@
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index c3814cd908..61e1ee8cd1 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -29,25 +29,23 @@ module Binary
    seekBy,
    tellBin,
    castBin,
+   isEOFBin,
+   withBinBuffer,
 
    writeBinMem,
    readBinMem,
 
-   fingerprintBinMem,
-   computeFingerprint,
-
-   isEOFBin,
-
    putAt, getAt,
 
-   -- for writing instances:
+   -- * For writing instances
    putByte,
    getByte,
 
-   -- lazy Bin I/O
+   -- * Lazy Binary I/O
    lazyGet,
    lazyPut,
 
+   -- * User data
    UserData(..), getUserData, setUserData,
    newReadState, newWriteState,
    putDictionary, getDictionary, putFS,
@@ -105,6 +103,17 @@ getUserData bh = bh_usr bh
 setUserData :: BinHandle -> UserData -> BinHandle
 setUserData bh us = bh { bh_usr = us }
 
+-- | Get access to the underlying buffer.
+--
+-- It is quite important that no references to the 'ByteString' leak out of the
+-- continuation lest terrible things happen.
+withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a
+withBinBuffer (BinMem _ ix_r _ arr_r) action = do
+  arr <- readIORef arr_r
+  ix <- readFastMutInt ix_r
+  withForeignPtr arr $ \ptr ->
+    BS.unsafePackCStringLen (castPtr ptr, ix) >>= action
+
 
 ---------------------------------------------------------------
 -- Bin
@@ -200,23 +209,6 @@ readBinMem filename = do
   writeFastMutInt sz_r filesize
   return (BinMem noUserData ix_r sz_r arr_r)
 
-fingerprintBinMem :: BinHandle -> IO Fingerprint
-fingerprintBinMem (BinMem _ ix_r _ arr_r) = do
-  arr <- readIORef arr_r
-  ix <- readFastMutInt ix_r
-  withForeignPtr arr $ \p -> fingerprintData p ix
-
-computeFingerprint :: Binary a
-                   => (BinHandle -> Name -> IO ())
-                   -> a
-                   -> IO Fingerprint
-
-computeFingerprint put_name a = do
-  bh <- openBinMem (3*1024) -- just less than a block
-  bh <- return $ setUserData bh $ newWriteState put_name putFS
-  put_ bh a
-  fingerprintBinMem bh
-
 -- expand the size of the array to include a specified offset
 expandBin :: BinHandle -> Int -> IO ()
 expandBin (BinMem _ _ sz_r arr_r) off = do
@@ -614,6 +606,25 @@ lazyGet bh = do
 -- UserData
 -- -----------------------------------------------------------------------------
 
+-- | Information we keep around during interface file
+-- serialization/deserialization. Namely we keep the functions for serializing
+-- and deserializing 'Name's and 'FastString's. We do this because we actually
+-- use serialization in two distinct settings,
+--
+-- * When serializing interface files themselves
+--
+-- * When computing the fingerprint of an IfaceDecl (which we computing by
+--   hashing its Binary serialization)
+--
+-- These two settings have different needs while serializing Names:
+--
+-- * Names in interface files are serialized via a symbol table (see Note
+--   [Symbol table representation of names] in BinIface).
+--
+-- * During fingerprinting a binding Name is serialized as the OccName and a
+--   non-binding Name is serialized as the fingerprint of the thing they
+--   represent. See Note [Fingerprinting IfaceDecls] for further discussion.
+--
 data UserData =
    UserData {
         -- for *deserialising* only:
@@ -621,27 +632,36 @@ data UserData =
         ud_get_fs   :: BinHandle -> IO FastString,
 
         -- for *serialising* only:
-        ud_put_name :: BinHandle -> Name       -> IO (),
+        ud_put_nonbinding_name :: BinHandle -> Name -> IO (),
+        -- ^ serialize a non-binding 'Name' (e.g. a reference to another
+        -- binding).
+        ud_put_binding_name :: BinHandle -> Name -> IO (),
+        -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl)
         ud_put_fs   :: BinHandle -> FastString -> IO ()
    }
 
-newReadState :: (BinHandle -> IO Name)
+newReadState :: (BinHandle -> IO Name)   -- ^ how to deserialize 'Name's
              -> (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_nonbinding_name = undef "put_nonbinding_name",
+               ud_put_binding_name    = undef "put_binding_name",
                ud_put_fs   = undef "put_fs"
              }
 
-newWriteState :: (BinHandle -> Name       -> IO ())
+newWriteState :: (BinHandle -> Name -> IO ())
+                 -- ^ how to serialize non-binding 'Name's
+              -> (BinHandle -> Name -> IO ())
+                 -- ^ how to serialize binding 'Name's
               -> (BinHandle -> FastString -> IO ())
               -> UserData
-newWriteState put_name put_fs
+newWriteState put_nonbinding_name put_binding_name put_fs
   = UserData { ud_get_name = undef "get_name",
                ud_get_fs   = undef "get_fs",
-               ud_put_name = put_name,
+               ud_put_nonbinding_name = put_nonbinding_name,
+               ud_put_binding_name    = put_binding_name,
                ud_put_fs   = put_fs
              }
 
diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
index ed4cd6fff7..f797654e0c 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -11,19 +11,25 @@
 -- ----------------------------------------------------------------------------
 
 module Fingerprint (
-        Fingerprint(..), fingerprint0,
         readHexFingerprint,
+        fingerprintByteString,
+        -- * Re-exported from GHC.Fingerprint
+        Fingerprint(..), fingerprint0,
         fingerprintData,
         fingerprintString,
-        -- Re-exported from GHC.Fingerprint
         getFileHash
    ) where
 
 #include "md5.h"
 ##include "HsVersions.h"
 
+import Foreign
+import GHC.IO
 import Numeric          ( readHex )
 
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BS
+
 import GHC.Fingerprint
 
 -- useful for parsing the output of 'md5sum', should we want to do that.
@@ -32,3 +38,8 @@ readHexFingerprint s = Fingerprint w1 w2
  where (s1,s2) = splitAt 16 s
        [(w1,"")] = readHex s1
        [(w2,"")] = readHex (take 16 s2)
+
+-- this can move to GHC.Fingerprint in GHC 8.6
+fingerprintByteString :: BS.ByteString -> Fingerprint
+fingerprintByteString bs = unsafeDupablePerformIO $
+  BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> fingerprintData (castPtr ptr) len