[commit: ghc] master: Clean up handling of knownKeyNames (7924469)
git at git.haskell.org
git at git.haskell.org
Wed Aug 26 20:25:50 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/792446906c718a08f0870b58acbdf2cfdeb77770/ghc
>---------------------------------------------------------------
commit 792446906c718a08f0870b58acbdf2cfdeb77770
Author: Ben Gamari <ben at smart-cactus.org>
Date: Wed Aug 26 17:58:25 2015 +0200
Clean up handling of knownKeyNames
>---------------------------------------------------------------
792446906c718a08f0870b58acbdf2cfdeb77770
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 c7cabe6..41418fa 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 5ab060e..9cfa78b 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
More information about the ghc-commits
mailing list