HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- ExternalPackageState(..),
+ ExternalPackageState(..), emptyExternalPackageState,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
lookupIface, lookupIfaceByModName, moduleNameToModule,
emptyModIface,
VersionInfo(..), initialVersionInfo, lookupVersion,
FixityEnv, lookupFixity, collectFixities, emptyFixityEnv,
- TyThing(..), isTyClThing, implicitTyThingIds,
+ TyThing(..), implicitTyThings,
TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
extendTypeEnvList, extendTypeEnvWithIds,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
- WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..), Dependencies,
+ WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..),
+ Dependencies(..), noDependencies,
IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn,
NameCache(..), OrigNameCache, OrigIParamCache,
Avails, availsToNameSet, availName, availNames,
import InstEnv ( InstEnv, ClsInstEnv, DFunId )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
-import Id ( Id )
-import Class ( Class, classSelIds )
-import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
-import Type ( TyThing(..), isTyClThing )
-import DataCon ( dataConWorkId, dataConWrapId )
+import Id ( Id, idName )
+import Class ( Class, classSelIds, classTyCon )
+import TyCon ( TyCon, tyConName, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons )
+import TcType ( TyThing(..) )
+import DataCon ( dataConWorkId, dataConWrapId, dataConWrapId_maybe )
import Packages ( PackageName, basePackage )
import CmdLineOpts ( DynFlags )
import CoreSyn ( IdCoreRule )
import PrelNames ( isBuiltInSyntaxName )
+import InstEnv ( emptyInstEnv )
+import Rules ( emptyRuleBase )
import FiniteMap
-import Bag ( Bag )
+import Bag ( Bag, emptyBag )
import Maybes ( orElse )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
Simple lookups in the symbol table.
\begin{code}
-lookupIface :: HomePackageTable -> PackageIfaceTable -> Name -> Maybe ModIface
+lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
-lookupIface hpt pit name
+lookupIface hpt pit mod
= case lookupModuleEnv hpt mod of
Just mod_info -> Just (hm_iface mod_info)
Nothing -> lookupModuleEnv pit mod
- where
- mod = nameModule name
lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
mi_package = basePackage, -- XXX fully bogus
mi_version = initialVersionInfo,
mi_usages = [],
- mi_deps = ([], []),
+ mi_deps = noDependencies,
mi_orphan = False,
mi_boot = False,
mi_exports = [],
typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
typeEnvIds env = [id | AnId id <- typeEnvElts env]
-
-implicitTyThingIds :: [TyThing] -> [Id]
--- Add the implicit data cons and selectors etc
-implicitTyThingIds things
- = concat (map go things)
- where
- go (AnId f) = []
- go (AClass cl) = classSelIds cl
- go (ATyCon tc) = tyConGenIds tc ++
- tyConSelIds tc ++
- [ n | dc <- tyConDataCons_maybe tc `orElse` [],
- n <- implicitConIds tc dc]
- -- Synonyms return empty list of constructors and selectors
-
- implicitConIds tc dc -- Newtypes have a constructor wrapper,
- -- but no worker
- | isNewTyCon tc = [dataConWrapId dc]
- | otherwise = [dataConWorkId dc, dataConWrapId dc]
\end{code}
mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
+-- Extend the type environment
extendTypeEnvList env things
- = extendNameEnvList env [(getName thing, thing) | thing <- things]
+ = foldl extend env things
+ where
+ extend env thing = extendNameEnv env (getName thing) thing
+
+implicitTyThings :: [TyThing] -> [TyThing]
+implicitTyThings things
+ = concatMap extras things
+ where
+ extras_plus thing = thing : extras thing
+
+ extras (AnId id) = []
+
+ -- For type constructors, add the data cons (and their extras),
+ -- and the selectors and generic-programming Ids too
+ --
+ -- Newtypes don't have a worker Id, so don't generate that
+ extras (ATyCon tc) = map AnId (tyConGenIds tc ++ tyConSelIds tc) ++ data_con_stuff
+ where
+ data_con_stuff | isNewTyCon tc = [ADataCon dc1, AnId (dataConWrapId dc1)]
+ | otherwise = concatMap (extras_plus . ADataCon) dcs
+ dcs = tyConDataCons tc
+ dc1 = head dcs
+
+ -- For classes, add the class TyCon too (and its extras)
+ -- and the class selector Ids
+ extras (AClass cl) = map AnId (classSelIds cl) ++
+ extras_plus (ATyCon (classTyCon cl))
+
+
+ -- For data cons add the worker and wrapper (if any)
+ extras (ADataCon dc)
+ = AnId (dataConWorkId dc) : wrap_id_stuff
+ where
+ -- May or may not have a wrapper
+ wrap_id_stuff = case dataConWrapId_maybe dc of
+ Just id -> [AnId id]
+ Nothing -> []
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds env ids
-- in the import hierarchy. See TcRnTypes.ImportAvails for details.
--
-- Invariant: the dependencies of a module M never includes M
-type Dependencies
- = ([(ModuleName, WhetherHasOrphans, IsBootInterface)], [PackageName])
-
+data Dependencies
+ = Deps { dep_mods :: [(ModuleName,IsBootInterface)], -- Home-package module dependencies
+ dep_pkgs :: [PackageName], -- External package dependencies
+ dep_orphs :: [ModuleName] } -- Orphan modules (whether home or external pkg)
+
+noDependencies :: Dependencies
+noDependencies = Deps [] [] []
+
data Usage name
= Usage { usg_name :: ModuleName, -- Name of the module
usg_mod :: Version, -- Module version
data PersistentCompilerState
= PCS {
pcs_nc :: !NameCache,
- pcs_EPS :: !ExternalPackageState
+ pcs_EPS :: ExternalPackageState
+ -- non-strict because we fill it with error in HscMain
}
\end{code}
-- for the home package we have all the instance
-- declarations anyhow
}
+
+emptyExternalPackageState = EPS {
+ eps_decls = (emptyNameEnv, 0),
+ eps_insts = (emptyBag, 0),
+ eps_inst_gates = emptyNameSet,
+ eps_rules = (emptyBag, 0),
+ eps_PIT = emptyPackageIfaceTable,
+ eps_PTE = emptyTypeEnv,
+ eps_inst_env = emptyInstEnv,
+ eps_rule_base = emptyRuleBase
+ }
\end{code}
The NameCache makes sure that there is just one Unique assigned for
data GlobalRdrElt
= GRE { gre_name :: Name,
- gre_parent :: Name, -- Name of the "parent" structure
- -- * the tycon of a data con
- -- * the class of a class op
- -- For others it's just the same as gre_name
- gre_prov :: Provenance, -- Why it's in scope
- gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
+ gre_parent :: Maybe Name, -- Name of the "parent" structure, for
+ -- * the tycon of a data con
+ -- * the class of a class op
+ -- For others it's Nothing
+ -- Invariant: gre_name g /= gre_parent g
+ -- when the latter is a Just
+
+ gre_prov :: Provenance, -- Why it's in scope
+ gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
}
instance Outputable GlobalRdrElt where
ppr gre = ppr (gre_name gre) <+>
- parens (hsep [text "parent:" <+> ppr (gre_parent gre) <> comma,
- pprNameProvenance gre])
+ parens (pp_parent (gre_parent gre) <+> pprNameProvenance gre)
+ where
+ pp_parent (Just p) = text "parent:" <+> ppr p <> comma
+ pp_parent Nothing = empty
+
pprGlobalRdrEnv env
= vcat (map pp (rdrEnvToList env))
where
ppr_reason ImplicitImport = ptext SLIT("implicitly imported")
ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
-ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("at") <+> ppr loc)
+ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
| otherwise = empty
\end{code}
projects / ghc-hetmet.git / blobdiff