1 files changed, 54 insertions, 57 deletions

diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index f76b62ee00..f79b6b1e7f 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -10,7 +10,7 @@ module PrelInfo (
         primOpRules, builtinRules,
 
         ghcPrimExports,
-        knownKeyNames,
+        wiredInThings, knownKeyNames,
         primOpId,
 
         -- Random other things
@@ -23,31 +23,56 @@ module PrelInfo (
 
 #include "HsVersions.h"
 
-import Constants        ( mAX_TUPLE_SIZE )
-import BasicTypes       ( Boxity(..) )
-import ConLike          ( ConLike(..) )
 import PrelNames
 import PrelRules
 import Avail
 import PrimOp
 import DataCon
 import Id
-import Name
 import MkId
+import Name( Name, getName )
 import TysPrim
 import TysWiredIn
 import HscTypes
 import Class
 import TyCon
+import Outputable
+import UniqFM
 import Util
 import {-# SOURCE #-} TcTypeNats ( typeNatTyCons )
 
+#ifdef GHCI
+import THNames
+#endif
+
 import Data.Array
 
-{-
-************************************************************************
+
+{- *********************************************************************
+*                                                                      *
+                Known key things
+*                                                                      *
+********************************************************************* -}
+
+knownKeyNames :: [Name]
+knownKeyNames =
+  ASSERT2( isNullUFM badNamesUFM, text "badknownKeyNames" <+> ppr badNamesUFM )
+  names
+  where
+  badNamesUFM = filterUFM (\ns -> length ns > 1) namesUFM
+  namesUFM = foldl (\m n -> addToUFM_Acc (:) singleton m n n) emptyUFM names
+  names = concat
+    [ map getName wiredInThings
+    , cTupleTyConNames
+    , basicKnownKeyNames
+#ifdef GHCI
+    , templateHaskellNames
+#endif
+    ]
+
+{- *********************************************************************
 *                                                                      *
-\subsection[builtinNameInfo]{Lookup built-in names}
+                Wired in things
 *                                                                      *
 ************************************************************************
 
@@ -62,61 +87,33 @@ Notes about wired in things
 
 * The name cache is initialised with (the names of) all wired-in things
 
-* 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
-  the type environment.
+* The type checker sees if the Name is wired in before looking up
+  the name in the type environment.  So the type envt itself contains
+  no wired in things.
 
 * MkIface prunes out wired-in things before putting them in an interface file.
   So interface files never contain wired-in things.
 -}
 
-
-knownKeyNames :: [Name]
--- This list is used to ensure that when you say "Prelude.map"
---  in your source code, or in an interface file,
--- 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 (rep_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 intreface files
-
-           , map idName wiredInIds
-           , map (idName . primOpId) allThePrimOps
-           , basicKnownKeyNames ]
+wiredInThings :: [TyThing]
+-- This list is used only to initialise HscMain.knownKeyNames
+-- to ensure that when you say "Prelude.map" in your source code, you
+-- get a Name with the correct known key (See Note [Known-key names])
+wiredInThings
+  = concat
+    [           -- Wired in TyCons and their implicit Ids
+          tycon_things
+        , concatMap implicitTyThings tycon_things
+
+                -- Wired in Ids
+        , map AnId wiredInIds
+
+                -- PrimOps
+        , map (AnId . primOpId) allThePrimOps
+    ]
   where
-    -- "kk" short for "known-key"
-    tycon_kk_names :: TyCon -> [Name]
-    tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc))
-
-    datacon_kk_names dc
-      | Promoted tc <- promoteDataCon_maybe dc = dataConName dc : rep_names tc
-      | otherwise                              = [dataConName 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 -> []
+    tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons
+                                    ++ typeNatTyCons)
 
 {-
 We let a lot of "non-standard" values be visible, so that we can make