[commit: ghc] master: Revert "Clean up handling of knownKeyNames" (a8601a8)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a8601a839f6f0d2bcd841aa46ebab00298f1c464/ghc

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

commit a8601a839f6f0d2bcd841aa46ebab00298f1c464
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Thu Aug 27 01:00:52 2015 +0200

    Revert "Clean up handling of knownKeyNames"
    
    This reverts commit 792446906c718a08f0870b58acbdf2cfdeb77770.
    
    This commit was a failed part of an effort to split up D757. I'll need
    to try again and make sure I build-test next time.


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

a8601a839f6f0d2bcd841aa46ebab00298f1c464
 compiler/main/HscMain.hs     |  12 +-----
 compiler/prelude/PrelInfo.hs | 100 +++++++++++++++++++++++--------------------
 2 files changed, 56 insertions(+), 56 deletions(-)

diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 41418fa..c7cabe6 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -91,8 +91,7 @@ import BasicTypes       ( HValue )
 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
 import Linker
 import CoreTidy         ( tidyExpr )
-import Type             ( Type )
-import {- Kind parts of -} Type         ( Kind )
+import Type             ( Type, Kind )
 import CoreLint         ( lintInteractiveExpr )
 import VarEnv           ( emptyTidyEnv )
 import Panic
@@ -178,7 +177,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 emptyModuleEnv
     return HscEnv {  hsc_dflags       = dflags,
                      hsc_targets      = [],
@@ -191,13 +190,6 @@ 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 9cfa78b..5ab060e 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
 
-{-
-************************************************************************
+
+{- *********************************************************************
 *                                                                      *
-\subsection[builtinNameInfo]{Lookup built-in names}
+                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
 *                                                                      *
 ************************************************************************
 
@@ -62,50 +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, 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 ]
+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