diff options
| -rw-r--r-- | compiler/main/HscMain.hs | 12 | ||||
| -rw-r--r-- | 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 41418fa50e..c7cabe6f9a 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 9cfa78b3f0..5ab060e941 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 |