Clean up handling of knownKeyNames

2 files changed, 56 insertions, 56 deletions

diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index c7cabe6f9a..41418fa50e 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -91,7 +91,8 @@ import BasicTypes       ( HValue )
 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
 import Linker
 import CoreTidy         ( tidyExpr )
-import Type             ( Type, Kind )
+import Type             ( Type )
+import {- Kind parts of -} Type         ( Kind )
 import CoreLint         ( lintInteractiveExpr )
 import VarEnv           ( emptyTidyEnv )
 import Panic
@@ -177,7 +178,7 @@ newHscEnv :: DynFlags -> IO HscEnv
 newHscEnv dflags = do
     eps_var <- newIORef initExternalPackageState
     us      <- mkSplitUniqSupply 'r'
-    nc_var  <- newIORef (initNameCache us knownKeyNames)
+    nc_var  <- newIORef (initNameCache us allKnownKeyNames)
     fc_var  <- newIORef emptyModuleEnv
     return HscEnv {  hsc_dflags       = dflags,
                      hsc_targets      = [],
@@ -190,6 +191,13 @@ newHscEnv dflags = do
                      hsc_type_env_var = Nothing }
 
 
+allKnownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
+allKnownKeyNames =              -- where templateHaskellNames are defined
+    knownKeyNames
+#ifdef GHCI
+        ++ templateHaskellNames
+#endif
+
 -- -----------------------------------------------------------------------------
 
 getWarnings :: Hsc WarningMessages
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index 5ab060e941..9cfa78b3f0 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -10,7 +10,7 @@ module PrelInfo (
         primOpRules, builtinRules,
 
         ghcPrimExports,
-        wiredInThings, knownKeyNames,
+        knownKeyNames,
         primOpId,
 
         -- Random other things
@@ -23,56 +23,31 @@ 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
-    ]
-
-{- *********************************************************************
+{-
+************************************************************************
 *                                                                      *
-                Wired in things
+\subsection[builtinNameInfo]{Lookup built-in names}
 *                                                                      *
 ************************************************************************
 
@@ -87,33 +62,50 @@ Notes about wired in things
 
 * The name cache is initialised with (the names of) all wired-in things
 
-* 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.
+* 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.
 
 * MkIface prunes out wired-in things before putting them in an interface file.
   So interface files never contain wired-in things.
 -}
 
-wiredInThings :: [TyThing]
--- This list is used only to initialise HscMain.knownKeyNames
--- to ensure that when you say "Prelude.map" in your source code, you
--- get a Name with the correct known key (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
-    ]
+
+knownKeyNames :: [Name]
+-- This list is used 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] in PrelNames)
+knownKeyNames
+  = concat [ tycon_kk_names funTyCon
+           , concatMap tycon_kk_names primTyCons
+           , concatMap tycon_kk_names wiredInTyCons
+           , concatMap tycon_kk_names typeNatTyCons
+           , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE]  -- Yuk
+           , map idName wiredInIds
+           , map (idName . primOpId) allThePrimOps
+           , basicKnownKeyNames ]
   where
-    tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons
-                                    ++ typeNatTyCons)
+    -- "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 -> []
 
 {-
 We let a lot of "non-standard" values be visible, so that we can make