Commit 79244690 authored by Ben Gamari's avatar Ben Gamari 🐢

Clean up handling of knownKeyNames

parent 89d25b9e
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment