, moduleString -- :: Module -> EncodedString
, moduleUserString -- :: Module -> UserString
- , mkVanillaModule -- :: ModuleName -> Module
- , isVanillaModule -- :: Module -> Bool
- , mkPrelModule -- :: UserString -> Module
+ , mkBasePkgModule -- :: UserString -> Module
+ , mkThPkgModule -- :: UserString -> Module
, mkHomeModule -- :: ModuleName -> Module
, isHomeModule -- :: Module -> Bool
, mkPackageModule -- :: ModuleName -> Module
#include "HsVersions.h"
import OccName
import Outputable
-import Packages ( PackageName, preludePackage )
+import Packages ( PackageName, basePackage, thPackage )
import CmdLineOpts ( opt_InPackage )
import FastString ( FastString )
import Unique ( Uniquable(..) )
\begin{code}
data Module = Module ModuleName !PackageInfo
-instance Binary Module where
- put_ bh (Module m p) = put_ bh m
- get bh = do m <- get bh; return (Module m DunnoYet)
-
data PackageInfo
= ThisPackage -- A module from the same package
-- as the one being compiled
| AnotherPackage -- A module from a different package
- | DunnoYet -- This is used when we don't yet know
- -- Main case: we've come across Foo.x in an interface file
- -- but we havn't yet opened Foo.hi. We need a Name for Foo.x
- -- Later on (in RnEnv.newTopBinder) we'll update the cache
- -- to have the right PackageName
-
packageInfoPackage :: PackageInfo -> PackageName
packageInfoPackage ThisPackage = opt_InPackage
-packageInfoPackage DunnoYet = FSLIT("<?>")
packageInfoPackage AnotherPackage = FSLIT("<pkg>")
instance Outputable PackageInfo where
\begin{code}
-mkPrelModule :: ModuleName -> Module
-mkPrelModule mod_nm
+mkBasePkgModule :: ModuleName -> Module
+mkBasePkgModule mod_nm
+ = Module mod_nm pack_info
+ where
+ pack_info
+ | opt_InPackage == basePackage = ThisPackage
+ | otherwise = AnotherPackage
+
+mkThPkgModule :: ModuleName -> Module
+mkThPkgModule mod_nm
= Module mod_nm pack_info
where
pack_info
- | opt_InPackage == preludePackage = ThisPackage
- | otherwise = AnotherPackage
+ | opt_InPackage == thPackage = ThisPackage
+ | otherwise = AnotherPackage
mkHomeModule :: ModuleName -> Module
mkHomeModule mod_nm = Module mod_nm ThisPackage
mkPackageModule :: ModuleName -> Module
mkPackageModule mod_nm = Module mod_nm AnotherPackage
--- Used temporarily when we first come across Foo.x in an interface
--- file, but before we've opened Foo.hi.
--- (Until we've opened Foo.hi we don't know what the Package is.)
-mkVanillaModule :: ModuleName -> Module
-mkVanillaModule name = Module name DunnoYet
-
-isVanillaModule :: Module -> Bool
-isVanillaModule (Module nm DunnoYet) = True
-isVanillaModule _ = False
-
moduleString :: Module -> EncodedString
moduleString (Module (ModuleName fs) _) = unpackFS fs
#include "HsVersions.h"
import OccName -- All of it
-import Module ( Module, ModuleName, moduleName, mkVanillaModule, isHomeModule )
+import Module ( Module, ModuleName, moduleName, isHomeModule )
import CmdLineOpts ( opt_Static )
import SrcLoc ( noSrcLoc, isWiredInLoc, wiredInSrcLoc, SrcLoc )
import Unique ( Unique, Uniquable(..), getKey, pprUnique )
mkExternalName :: Unique -> Module -> OccName -> SrcLoc -> Name
mkExternalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = External mod,
- n_occ = occ, n_loc = loc }
+ n_occ = occ, n_loc = loc }
-mkKnownKeyExternalName :: ModuleName -> OccName -> Unique -> Name
+mkKnownKeyExternalName :: Module -> OccName -> Unique -> Name
mkKnownKeyExternalName mod occ uniq
- = mkExternalName uniq (mkVanillaModule mod) occ noSrcLoc
+ = mkExternalName uniq mod occ noSrcLoc
mkWiredInName :: Module -> OccName -> Unique -> Name
mkWiredInName mod occ uniq = mkExternalName uniq mod occ wiredInSrcLoc
import HsSyn ( MonoBinds, RuleDecl(..), RuleBndr(..),
HsExpr(..), HsBinds(..), MonoBinds(..) )
import TcHsSyn ( TypecheckedRuleDecl, TypecheckedHsExpr )
-import TcRnTypes ( TcGblEnv(..), ImportAvails(imp_mods) )
+import TcRnTypes ( TcGblEnv(..), ImportAvails(..) )
import MkIface ( mkUsageInfo )
import Id ( Id )
import CoreSyn
(printDump (ppr_ds_rules ds_rules))
; let
+ deps = (moduleEnvElts (dep_mods imports), dep_pkgs imports)
mod_guts = ModGuts {
mg_module = mod,
mg_exports = exports,
+ mg_deps = deps,
mg_usages = mkUsageInfo hsc_env eps imports usages,
mg_dir_imps = [m | (m,_) <- moduleEnvElts (imp_mods imports)],
mg_rdr_env = rdr_env,
toHsType
)
-import PrelNames ( mETA_META_Name, varQual, tcQual )
+import PrelNames ( mETA_META_Name )
import MkIface ( ifaceTyThing )
import Name ( Name, nameOccName, nameModule )
import OccName ( isDataOcc, isTvOcc, occNameUserString )
+-- To avoid clashes with DsMeta.varName we must make a local alias for OccName.varName
+-- we do this by removing varName from the import of OccName above, making
+-- a qualified instance of OccName and using OccNameAlias.varName where varName
+-- ws previously used in this file.
+import qualified OccName( varName, tcName )
+
import Module ( moduleUserString )
import Id ( Id, idType )
import NameEnv
decTyConName, typTyConName ]
-
-intLName = varQual mETA_META_Name FSLIT("intL") intLIdKey
-charLName = varQual mETA_META_Name FSLIT("charL") charLIdKey
-plitName = varQual mETA_META_Name FSLIT("plit") plitIdKey
-pvarName = varQual mETA_META_Name FSLIT("pvar") pvarIdKey
-ptupName = varQual mETA_META_Name FSLIT("ptup") ptupIdKey
-pconName = varQual mETA_META_Name FSLIT("pcon") pconIdKey
-ptildeName = varQual mETA_META_Name FSLIT("ptilde") ptildeIdKey
-paspatName = varQual mETA_META_Name FSLIT("paspat") paspatIdKey
-pwildName = varQual mETA_META_Name FSLIT("pwild") pwildIdKey
-varName = varQual mETA_META_Name FSLIT("var") varIdKey
-conName = varQual mETA_META_Name FSLIT("con") conIdKey
-litName = varQual mETA_META_Name FSLIT("lit") litIdKey
-appName = varQual mETA_META_Name FSLIT("app") appIdKey
-infixEName = varQual mETA_META_Name FSLIT("infixE") infixEIdKey
-lamName = varQual mETA_META_Name FSLIT("lam") lamIdKey
-tupName = varQual mETA_META_Name FSLIT("tup") tupIdKey
-doEName = varQual mETA_META_Name FSLIT("doE") doEIdKey
-compName = varQual mETA_META_Name FSLIT("comp") compIdKey
-listExpName = varQual mETA_META_Name FSLIT("listExp") listExpIdKey
-condName = varQual mETA_META_Name FSLIT("cond") condIdKey
-letEName = varQual mETA_META_Name FSLIT("letE") letEIdKey
-caseEName = varQual mETA_META_Name FSLIT("caseE") caseEIdKey
-infixAppName = varQual mETA_META_Name FSLIT("infixApp") infixAppIdKey
-sectionLName = varQual mETA_META_Name FSLIT("sectionL") sectionLIdKey
-sectionRName = varQual mETA_META_Name FSLIT("sectionR") sectionRIdKey
-guardedName = varQual mETA_META_Name FSLIT("guarded") guardedIdKey
-normalName = varQual mETA_META_Name FSLIT("normal") normalIdKey
-bindStName = varQual mETA_META_Name FSLIT("bindSt") bindStIdKey
-letStName = varQual mETA_META_Name FSLIT("letSt") letStIdKey
-noBindStName = varQual mETA_META_Name FSLIT("noBindSt") noBindStIdKey
-parStName = varQual mETA_META_Name FSLIT("parSt") parStIdKey
-fromName = varQual mETA_META_Name FSLIT("from") fromIdKey
-fromThenName = varQual mETA_META_Name FSLIT("fromThen") fromThenIdKey
-fromToName = varQual mETA_META_Name FSLIT("fromTo") fromToIdKey
-fromThenToName = varQual mETA_META_Name FSLIT("fromThenTo") fromThenToIdKey
-liftName = varQual mETA_META_Name FSLIT("lift") liftIdKey
-gensymName = varQual mETA_META_Name FSLIT("gensym") gensymIdKey
-returnQName = varQual mETA_META_Name FSLIT("returnQ") returnQIdKey
-bindQName = varQual mETA_META_Name FSLIT("bindQ") bindQIdKey
+varQual = mk_known_key_name OccName.varName
+tcQual = mk_known_key_name OccName.tcName
+
+thModule :: Module
+-- NB: the THSyntax module comes from the "haskell-src" package
+thModule = mkThPkgModule mETA_META_Name
+
+mk_known_key_name space mod str uniq
+ = mkKnownKeyExternalName thModule (mkOccFS space str) uniq
+
+intLName = varQual FSLIT("intL") intLIdKey
+charLName = varQual FSLIT("charL") charLIdKey
+plitName = varQual FSLIT("plit") plitIdKey
+pvarName = varQual FSLIT("pvar") pvarIdKey
+ptupName = varQual FSLIT("ptup") ptupIdKey
+pconName = varQual FSLIT("pcon") pconIdKey
+ptildeName = varQual FSLIT("ptilde") ptildeIdKey
+paspatName = varQual FSLIT("paspat") paspatIdKey
+pwildName = varQual FSLIT("pwild") pwildIdKey
+varName = varQual FSLIT("var") varIdKey
+conName = varQual FSLIT("con") conIdKey
+litName = varQual FSLIT("lit") litIdKey
+appName = varQual FSLIT("app") appIdKey
+infixEName = varQual FSLIT("infixE") infixEIdKey
+lamName = varQual FSLIT("lam") lamIdKey
+tupName = varQual FSLIT("tup") tupIdKey
+doEName = varQual FSLIT("doE") doEIdKey
+compName = varQual FSLIT("comp") compIdKey
+listExpName = varQual FSLIT("listExp") listExpIdKey
+condName = varQual FSLIT("cond") condIdKey
+letEName = varQual FSLIT("letE") letEIdKey
+caseEName = varQual FSLIT("caseE") caseEIdKey
+infixAppName = varQual FSLIT("infixApp") infixAppIdKey
+sectionLName = varQual FSLIT("sectionL") sectionLIdKey
+sectionRName = varQual FSLIT("sectionR") sectionRIdKey
+guardedName = varQual FSLIT("guarded") guardedIdKey
+normalName = varQual FSLIT("normal") normalIdKey
+bindStName = varQual FSLIT("bindSt") bindStIdKey
+letStName = varQual FSLIT("letSt") letStIdKey
+noBindStName = varQual FSLIT("noBindSt") noBindStIdKey
+parStName = varQual FSLIT("parSt") parStIdKey
+fromName = varQual FSLIT("from") fromIdKey
+fromThenName = varQual FSLIT("fromThen") fromThenIdKey
+fromToName = varQual FSLIT("fromTo") fromToIdKey
+fromThenToName = varQual FSLIT("fromThenTo") fromThenToIdKey
+liftName = varQual FSLIT("lift") liftIdKey
+gensymName = varQual FSLIT("gensym") gensymIdKey
+returnQName = varQual FSLIT("returnQ") returnQIdKey
+bindQName = varQual FSLIT("bindQ") bindQIdKey
-- type Mat = ...
-matchName = varQual mETA_META_Name FSLIT("match") matchIdKey
-
--- type Cls = ...
-clauseName = varQual mETA_META_Name FSLIT("clause") clauseIdKey
-
--- data Dec = ...
-funName = varQual mETA_META_Name FSLIT("fun") funIdKey
-valName = varQual mETA_META_Name FSLIT("val") valIdKey
-dataDName = varQual mETA_META_Name FSLIT("dataD") dataDIdKey
-classDName = varQual mETA_META_Name FSLIT("classD") classDIdKey
-instName = varQual mETA_META_Name FSLIT("inst") instIdKey
-protoName = varQual mETA_META_Name FSLIT("proto") protoIdKey
-
--- data Typ = ...
-tvarName = varQual mETA_META_Name FSLIT("tvar") tvarIdKey
-tconName = varQual mETA_META_Name FSLIT("tcon") tconIdKey
-tappName = varQual mETA_META_Name FSLIT("tapp") tappIdKey
-
--- data Tag = ...
-arrowTyConName = varQual mETA_META_Name FSLIT("arrowTyCon") arrowIdKey
-tupleTyConName = varQual mETA_META_Name FSLIT("tupleTyCon") tupleIdKey
-listTyConName = varQual mETA_META_Name FSLIT("listTyCon") listIdKey
-namedTyConName = varQual mETA_META_Name FSLIT("namedTyCon") namedTyConIdKey
-
--- data Con = ...
-constrName = varQual mETA_META_Name FSLIT("constr") constrIdKey
-
-exprTyConName = tcQual mETA_META_Name FSLIT("Expr") exprTyConKey
-declTyConName = tcQual mETA_META_Name FSLIT("Decl") declTyConKey
-pattTyConName = tcQual mETA_META_Name FSLIT("Patt") pattTyConKey
-mtchTyConName = tcQual mETA_META_Name FSLIT("Mtch") mtchTyConKey
-clseTyConName = tcQual mETA_META_Name FSLIT("Clse") clseTyConKey
-stmtTyConName = tcQual mETA_META_Name FSLIT("Stmt") stmtTyConKey
-consTyConName = tcQual mETA_META_Name FSLIT("Cons") consTyConKey
-typeTyConName = tcQual mETA_META_Name FSLIT("Type") typeTyConKey
-
-qTyConName = tcQual mETA_META_Name FSLIT("Q") qTyConKey
-expTyConName = tcQual mETA_META_Name FSLIT("Exp") expTyConKey
-decTyConName = tcQual mETA_META_Name FSLIT("Dec") decTyConKey
-typTyConName = tcQual mETA_META_Name FSLIT("Typ") typTyConKey
-matTyConName = tcQual mETA_META_Name FSLIT("Mat") matTyConKey
-clsTyConName = tcQual mETA_META_Name FSLIT("Cls") clsTyConKey
+matchName = varQual FSLIT("match") matchIdKey
+
+-- type Cls = ...
+clauseName = varQual FSLIT("clause") clauseIdKey
+
+-- data Dec = ...
+funName = varQual FSLIT("fun") funIdKey
+valName = varQual FSLIT("val") valIdKey
+dataDName = varQual FSLIT("dataD") dataDIdKey
+classDName = varQual FSLIT("classD") classDIdKey
+instName = varQual FSLIT("inst") instIdKey
+protoName = varQual FSLIT("proto") protoIdKey
+
+-- data Typ = ...
+tvarName = varQual FSLIT("tvar") tvarIdKey
+tconName = varQual FSLIT("tcon") tconIdKey
+tappName = varQual FSLIT("tapp") tappIdKey
+
+-- data Tag = ...
+arrowTyConName = varQual FSLIT("arrowTyCon") arrowIdKey
+tupleTyConName = varQual FSLIT("tupleTyCon") tupleIdKey
+listTyConName = varQual FSLIT("listTyCon") listIdKey
+namedTyConName = varQual FSLIT("namedTyCon") namedTyConIdKey
+
+-- data Con = ...
+constrName = varQual FSLIT("constr") constrIdKey
+
+exprTyConName = tcQual FSLIT("Expr") exprTyConKey
+declTyConName = tcQual FSLIT("Decl") declTyConKey
+pattTyConName = tcQual FSLIT("Patt") pattTyConKey
+mtchTyConName = tcQual FSLIT("Mtch") mtchTyConKey
+clseTyConName = tcQual FSLIT("Clse") clseTyConKey
+stmtTyConName = tcQual FSLIT("Stmt") stmtTyConKey
+consTyConName = tcQual FSLIT("Cons") consTyConKey
+typeTyConName = tcQual FSLIT("Type") typeTyConKey
+
+qTyConName = tcQual FSLIT("Q") qTyConKey
+expTyConName = tcQual FSLIT("Exp") expTyConKey
+decTyConName = tcQual FSLIT("Dec") decTyConKey
+typTyConName = tcQual FSLIT("Typ") typTyConKey
+matTyConName = tcQual FSLIT("Mat") matTyConKey
+clsTyConName = tcQual FSLIT("Cls") clsTyConKey
-- TyConUniques available: 100-119
-- Check in PrelNames if you want to change this
tyClDeclName, tyClDeclNames, tyClDeclTyVars,
isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl,
isTypeOrClassDecl, countTyClDecls,
- isSourceInstDecl, ifaceRuleDeclName,
+ isSourceInstDecl, instDeclDFun, ifaceRuleDeclName,
conDetailsTys,
collectRuleBndrSigTys, isSrcRule
) where
isSourceInstDecl :: InstDecl name -> Bool
isSourceInstDecl (InstDecl _ _ _ maybe_dfun _) = isNothing maybe_dfun
+
+instDeclDFun :: InstDecl name -> Maybe name
+instDeclDFun (InstDecl _ _ _ df _) = df -- A Maybe, but that's ok
\end{code}
\begin{code}
import Subst ( substTyWith )
import Module ( Module, PackageName, ModuleName, moduleName,
- modulePackage, preludePackage,
+ modulePackage, basePackage,
isHomeModule, isVanillaModule,
pprModuleName, mkHomeModule, mkModuleName
)
importsPrelude | inPrelude = addModuleImpInfo (mkModuleName "PrelGHC")
- | otherwise = addPackageImpInfo preludePackage
+ | otherwise = addPackageImpInfo basePackage
importsType :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo
-- gets things working for the scenario "standard library linked as one
-- assembly with multiple modules + a one module program running on top of this"
-- Same applies to all other mentions of Vailla modules in this file
- | isVanillaModule (nameModule n) && not inPrelude = preludePackageReference
+ | isVanillaModule (nameModule n) && not inPrelude = basePackageReference
| isVanillaModule (nameModule n) && inPrelude = moduleNameReference (moduleName (nameModule n))
-- end hack
| otherwise = packageReference (modulePackage (nameModule n))
| ilxEnvModule env == m = text ""
| isHomeModule m = moduleNameReference (moduleName m)
-- See hack above
- | isVanillaModule m && not inPrelude = preludePackageReference
+ | isVanillaModule m && not inPrelude = basePackageReference
| isVanillaModule m && inPrelude = moduleNameReference (moduleName m)
-- end hack
| otherwise = packageReference (modulePackage m)
-preludePackageReference = packageReference preludePackage
-inPrelude = preludePackage == opt_InPackage
+basePackageReference = packageReference basePackage
+inPrelude = basePackage == opt_InPackage
------------------------------------------------
-- This code is copied from absCSyn/CString.lhs,
prelGHCReference env =
if ilxEnvModule env == mkHomeModule (mkModuleName "PrelGHC") then empty
else if inPrelude then moduleNameReference (mkModuleName "PrelGHC")
- else preludePackageReference
+ else basePackageReference
prelBaseReference :: IlxTyFrag
prelBaseReference env =
if ilxEnvModule env == mkHomeModule (mkModuleName "PrelBase") then empty
else if inPrelude then moduleNameReference (mkModuleName "PrelBase")
- else preludePackageReference
+ else basePackageReference
repThread = ilxType "class [mscorlib]System.Threading.Thread /* ThreadId# */ "
repByteArray = ilxType "unsigned int8[] /* ByteArr# */ "
put_ bh iface = do
build_tag <- readIORef v_Build_tag
put_ bh (show opt_HiVersion ++ build_tag)
- p <- put_ bh (mi_module iface)
+ p <- put_ bh (moduleName (mi_module iface))
put_ bh (mi_package iface)
put_ bh (vers_module (mi_version iface))
put_ bh (mi_orphan iface)
-- no: mi_boot
- lazyPut bh (map importVersionNameToOccName (mi_usages iface))
+ lazyPut bh (mi_deps iface)
+ lazyPut bh (map usageToOccName (mi_usages iface))
put_ bh (vers_exports (mi_version iface),
map exportItemToRdrExportItem (mi_exports iface))
put_ bh (declsToVersionedDecls (dcl_tycl (mi_decls iface))
{-! for WhatsImported derive: Binary !-}
-- For binary interfaces we need to convert the ImportVersion Names to OccNames
-importVersionNameToOccName :: ImportVersion Name -> ImportVersion OccName
-importVersionNameToOccName (mod, orphans, boot, what)
- = (mod, orphans, boot, fiddle_with what)
- where fiddle_with NothingAtAll = NothingAtAll
- fiddle_with (Everything v) = Everything v
- fiddle_with (Specifically v ev ns rv) = Specifically v ev ns' rv
- where ns' = [ (nameOccName n, v) | (n,v) <- ns ]
-
+usageToOccName :: Usage Name -> Usage OccName
+usageToOccName usg
+ = usg { usg_entities = [ (nameOccName n, v) | (n,v) <- usg_entities usg ] }
exportItemToRdrExportItem (mn, avails)
= (mn, map availInfoToRdrAvailInfo avails)
pkg_name <- get bh
module_ver <- get bh
orphan <- get bh
+ deps <- lazyGet bh
usages <- {-# SCC "bin_usages" #-} lazyGet bh
exports <- {-# SCC "bin_exports" #-} get bh
tycl_decls <- {-# SCC "bin_tycldecls" #-} get bh
pi_pkg = pkg_name,
pi_vers = module_ver,
pi_orphan = orphan,
+ pi_deps = deps,
pi_usages = usages,
pi_exports = exports,
pi_decls = tycl_decls,
ac <- get bh
return (AvailTC ab ac)
-instance (Binary name) => Binary (WhatsImported name) where
- put_ bh NothingAtAll = do
- putByte bh 0
- put_ bh (Everything aa) = do
- putByte bh 1
- put_ bh aa
- put_ bh (Specifically ab ac ad ae) = do
- putByte bh 2
- put_ bh ab
- put_ bh ac
- put_ bh ad
- put_ bh ae
+instance (Binary name) => Binary (Usage name) where
+ put_ bh usg = do
+ put_ bh (usg_name usg)
+ put_ bh (usg_mod usg)
+ put_ bh (usg_exports usg)
+ put_ bh (usg_entities usg)
+ put_ bh (usg_rules usg)
+
get bh = do
- h <- getByte bh
- case h of
- 0 -> do return NothingAtAll
- 1 -> do aa <- get bh
- return (Everything aa)
- _ -> do ab <- get bh
- ac <- get bh
- ad <- get bh
- ae <- get bh
- return (Specifically ab ac ad ae)
+ nm <- get bh
+ mod <- get bh
+ exps <- get bh
+ ents <- get bh
+ rules <- get bh
+ return (Usage { usg_name = nm, usg_mod = mod,
+ usg_exports = exps, usg_entities = ents,
+ usg_rules = rules })
instance Binary Activation where
put_ bh NeverActive = do
-- opts from -optl-<blah>
extra_ld_opts <- getStaticOpts v_Opt_l
- [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, preludePackage]
+ [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, basePackage]
let extra_os = if static || no_hs_main
then []
-- opts from -optdll-<blah>
extra_ld_opts <- getStaticOpts v_Opt_dll
- [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, preludePackage]
+ [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, basePackage]
let extra_os = if static || no_hs_main
then []
-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.83 2002/10/17 14:26:18 simonmar Exp $
+-- $Id: DriverState.hs,v 1.84 2002/10/24 14:17:49 simonpj Exp $
--
-- Settings for the driver
--
PackageName, mkPackageName, packageNameString,
packageDependents,
mungePackagePaths, emptyPkgMap, extendPkgMap, lookupPkg,
- preludePackage, rtsPackage, haskell98Package )
+ basePackage, rtsPackage, haskell98Package )
import CmdLineOpts
import DriverPhases
import DriverUtil
getPackages = readIORef v_Packages
initPackageList = [haskell98Package,
- preludePackage,
+ basePackage,
rtsPackage]
addPackage :: String -> IO ()
import Lex ( ParseResult(..), ExtFlags(..), mkPState )
import SrcLoc ( mkSrcLoc )
import TcRnDriver ( checkOldIface, tcRnModule, tcRnExtCore, tcRnIface )
+import RnEnv ( extendOrigNameCache )
import Rules ( emptyRuleBase )
import PrelInfo ( wiredInThingEnv, wiredInThings, knownKeyNames )
import PrelRules ( builtinRules )
import CodeGen ( codeGen )
import CodeOutput ( codeOutput )
-import Module ( ModuleName, moduleName )
+import Module ( ModuleName, moduleName, emptyModuleEnv )
import CmdLineOpts
import DriverPhases ( isExtCore_file )
import ErrUtils ( dumpIfSet_dyn, showPass, printError )
eps_insts = (emptyBag, 0),
eps_inst_gates = emptyNameSet,
eps_rules = foldr add_rule (emptyBag, 0) builtinRules,
- eps_imp_mods = emptyFM,
eps_PIT = emptyPackageIfaceTable,
eps_PTE = wiredInThingEnv,
rdr_name = nameRdrName name
gate_fn vis_fn = vis_fn name -- Load the rule whenever name is visible
-initOrigNames :: FiniteMap (ModuleName,OccName) Name
+initOrigNames :: OrigNameCache
initOrigNames
- = grab knownKeyNames `plusFM` grab (map getName wiredInThings)
- where
- grab names = foldl add emptyFM names
- add env name
- = addToFM env (moduleName (nameModule name), nameOccName name) name
+ = insert knownKeyNames $
+ insert (map getName wiredInThings) $
+ emptyModuleEnv
+ where
+ insert names env = foldl extendOrigNameCache env names
\end{code}
extendTypeEnvList, extendTypeEnvWithIds,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
- ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
- IsBootInterface, DeclsMap,
+ WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..), Dependencies,
IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn,
NameCache(..), OrigNameCache, OrigIParamCache,
Avails, availsToNameSet, availName, availNames,
import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
import Type ( TyThing(..), isTyClThing )
import DataCon ( dataConWorkId, dataConWrapId )
-import Packages ( PackageName, preludePackage )
+import Packages ( PackageName, basePackage )
import CmdLineOpts ( DynFlags )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, FixitySig(..), defaultFixity )
-import HsSyn ( DeprecTxt, TyClDecl, InstDecl, RuleDecl,
- tyClDeclName, ifaceRuleDeclName, tyClDeclNames )
+import HsSyn ( DeprecTxt, TyClDecl, InstDecl, RuleDecl,
+ tyClDeclName, ifaceRuleDeclName, tyClDeclNames,
+ instDeclDFun )
import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
import CoreSyn ( IdCoreRule )
= ModIface {
mi_module :: !Module,
mi_package :: !PackageName, -- Which package the module comes from
- mi_version :: !VersionInfo, -- Module version number
+ mi_version :: !VersionInfo, -- Version info for everything in this module
mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans
mi_boot :: !IsBootInterface, -- Read from an hi-boot file?
- mi_usages :: [ImportVersion Name],
+ mi_deps :: Dependencies,
+ -- This is consulted for directly-imported modules, but
+ -- not for anything else
+
+ mi_usages :: [Usage Name],
-- Usages; kept sorted so that it's easy to decide
-- whether to write a new iface file (changing usages
-- doesn't affect the version of this module)
-- NOT STRICT! we read this field lazily from the interface file
+ -- It is *only* consulted by the recompilation checker
mi_exports :: ![ExportItem],
-- What it exports Kept sorted by (mod,occ), to make
md_rules :: ![IdCoreRule] -- Domain may include Ids from other modules
}
-
-
-- A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module
-- being compiled right now. Once it is compiled, a ModIface and
data ModGuts
= ModGuts {
mg_module :: !Module,
- mg_exports :: !Avails, -- What it exports
- mg_usages :: ![ImportVersion Name], -- What it imports, directly or otherwise
- -- ...exactly as in ModIface
- mg_dir_imps :: ![Module], -- Directly imported modules
+ mg_exports :: !Avails, -- What it exports
+ mg_deps :: !Dependencies, -- What is below it, directly or otherwise
+ mg_dir_imps :: ![Module], -- Directly-imported modules; used to
+ -- generate initialisation code
+ mg_usages :: ![Usage Name], -- Version info for what it needed
mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment
mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in this module
dcl_insts :: [RenamedInstDecl] } -- Unsorted
mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls
+-- Sort to put them in canonical order for version comparison
mkIfaceDecls tycls rules insts
= IfaceDecls { dcl_tycl = sortLt lt_tycl tycls,
dcl_rules = sortLt lt_rule rules,
- dcl_insts = insts }
+ dcl_insts = sortLt lt_inst insts }
where
d1 `lt_tycl` d2 = tyClDeclName d1 < tyClDeclName d2
r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
+ i1 `lt_inst` i2 = instDeclDFun i1 < instDeclDFun i2
\end{code}
\begin{code}
emptyModIface :: Module -> ModIface
emptyModIface mod
= ModIface { mi_module = mod,
- mi_package = preludePackage, -- XXX fully bogus
+ mi_package = basePackage, -- XXX fully bogus
mi_version = initialVersionInfo,
mi_usages = [],
+ mi_deps = ([], []),
mi_orphan = False,
mi_boot = False,
mi_exports = [],
pi_pkg :: PackageName,
pi_vers :: Version, -- Module version number
pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
- pi_usages :: [ImportVersion OccName], -- Usages
+ pi_deps :: Dependencies, -- What it depends on
+ pi_usages :: [Usage OccName], -- Usages
pi_exports :: (Version, [RdrExportItem]), -- Exports
pi_decls :: [(Version, TyClDecl RdrName)], -- Local definitions
pi_fixity :: [FixitySig RdrName], -- Local fixity declarations,
-- * a transformation rule in a module other than the one defining
-- the function in the head of the rule.
-type IsBootInterface = Bool
-
-type ImportVersion name = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
-
-data WhatsImported name = NothingAtAll -- The module is below us in the
- -- hierarchy, but we import nothing
- -- Used for orphan modules, so they appear
- -- in the usage list
-
- | Everything Version -- Used for modules from other packages;
- -- we record only the module's version number
-
- | Specifically
- Version -- Module version
- (Maybe Version) -- Export-list version, if we depend on it
- [(name,Version)] -- List guaranteed non-empty
- Version -- Rules version
+type IsBootInterface = Bool
- deriving( Eq )
- -- 'Specifically' doesn't let you say "I imported f but none of the rules in
+-- Dependency info about modules and packages below this one
+-- 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 Usage name
+ = Usage { usg_name :: ModuleName, -- Name of the module
+ usg_mod :: Version, -- Module version
+ usg_exports :: Maybe Version, -- Export-list version, if we depend on it
+ usg_entities :: [(name,Version)], -- Sorted by occurrence name
+ usg_rules :: Version -- Rules version
+ } deriving( Eq )
+ -- This type doesn't let you say "I imported f but none of the rules in
-- the module". If you use anything in the module you get its rule version
-- So if the rules change, you'll recompile, even if you don't use them.
-- This is easy to implement, and it's safer: you might not have used the rules last
-- time round, but if someone has added a new rule you might need it this time
-- The export list field is (Just v) if we depend on the export list:
- -- we imported the module without saying exactly what we imported
+ -- i.e. we imported the module without saying exactly what we imported
-- We need to recompile if the module exports changes, because we might
-- now have a name clash in the importing module.
\end{code}
-- * Fixities
-- * Deprecations
- eps_imp_mods :: !ImportedModuleInfo,
- -- Modules that we know something about, because they are mentioned
- -- in interface files, BUT which we have not loaded yet.
- -- No module is both in here and in the PIT
-
eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules
eps_inst_env :: !PackageInstEnv, -- The total InstEnv accumulated from
-- Ensures that one implicit parameter name gets one unique
}
-type OrigNameCache = FiniteMap (ModuleName,OccName) Name
-type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name)
-\end{code}
+type OrigNameCache = ModuleEnv (Module, OccNameCache)
+ -- Maps a module *name* to a Module,
+ -- plus the OccNameEnv fot that module
+type OccNameCache = FiniteMap OccName Name
+ -- Maps the OccName to a Name
+ -- A FiniteMap because OccNames have a Namespace/Faststring pair
-@ImportedModuleInfo@ contains info ONLY about modules that have not yet
-been loaded into the iPIT. These modules are mentioned in interfaces we've
-already read, so we know a tiny bit about them, but we havn't yet looked
-at the interface file for the module itself. It needs to persist across
-invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource.
-And there's no harm in it persisting across multiple compilations.
-
-\begin{code}
-type ImportedModuleInfo
- = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
+type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name)
\end{code}
A DeclsMap contains a binding for each Name in the declaration
\begin{code}
module MkIface (
showIface, mkIface, mkUsageInfo,
- pprIface, pprUsage, pprUsages, pprExports,
+ pprIface,
ifaceTyThing,
) where
)
import NewDemand ( isTopSig )
import TcRnMonad
+import TcRnTypes ( ImportAvails(..) )
import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl )
import HscTypes ( VersionInfo(..), ModIface(..), HomeModInfo(..),
ModGuts(..), ModGuts,
GhciMode(..), HscEnv(..),
FixityEnv, lookupFixity, collectFixities,
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
- TyThing(..), DFunId,
+ TyThing(..), DFunId, Dependencies,
Avails, AvailInfo, GenAvailInfo(..), availName,
ExternalPackageState(..),
- WhatsImported(..), ParsedIface(..),
- ImportVersion, Deprecations(..), initialVersionInfo,
+ ParsedIface(..), Usage(..),
+ Deprecations(..), initialVersionInfo,
lookupVersion
)
import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule,
ModLocation(..), mkSysModuleNameFS,
ModuleEnv, emptyModuleEnv, foldModuleEnv, lookupModuleEnv,
- extendModuleEnv_C, elemModuleSet, moduleEnvElts
+ extendModuleEnv_C, elemModuleSet, moduleEnvElts, elemModuleEnv
)
import Outputable
import Util ( sortLt, dropList, seqList )
import FastString
import Monad ( when )
-import Maybe ( catMaybes, isJust )
+import Maybe ( catMaybes, isJust, isNothing )
+import Maybes ( orElse )
import IO ( putStrLn )
\end{code}
parsed_iface <- Binary.getBinFileWithDict filename
let ParsedIface{
pi_mod=pi_mod, pi_pkg=pi_pkg, pi_vers=pi_vers,
+ pi_deps=pi_deps,
pi_orphan=pi_orphan, pi_usages=pi_usages,
pi_exports=pi_exports, pi_decls=pi_decls,
pi_fixity=pi_fixity, pi_insts=pi_insts,
<+> ptext SLIT("where"),
-- no instance Outputable (WhatsImported):
pprExports id (snd pi_exports),
+ pprDeps pi_deps,
pprUsages id pi_usages,
hsep (map ppr_fix pi_fixity) <> semi,
vcat (map ppr_inst pi_insts),
mkIface hsc_env location maybe_old_iface
impl@ModGuts{ mg_module = this_mod,
mg_usages = usages,
+ mg_deps = deps,
mg_exports = exports,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
iface_w_decls = ModIface { mi_module = this_mod,
mi_package = opt_InPackage,
mi_version = initialVersionInfo,
+ mi_deps = deps,
mi_usages = usages,
mi_exports = my_exports,
mi_decls = new_decls,
\begin{code}
mkUsageInfo :: HscEnv -> ExternalPackageState
- -> ImportAvails -> Usages
- -> [ImportVersion Name]
+ -> ImportAvails -> EntityUsage
+ -> [Usage Name]
mkUsageInfo hsc_env eps
- (ImportAvails { imp_mods = dir_imp_mods })
- (Usages { usg_ext = pkg_mods,
- usg_home = home_names })
- = let
- hpt = hsc_HPT hsc_env
- pit = eps_PIT eps
-
- import_all_mods = [moduleName m | (m,True) <- moduleEnvElts dir_imp_mods]
-
- -- mv_map groups together all the things imported and used
- -- from a particular module in this package
- -- We use a finite map because we want the domain
- mv_map :: ModuleEnv [Name]
- mv_map = foldNameSet add_mv emptyModuleEnv home_names
- add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
- where
- mod = nameModule name
- add_item names _ = name:names
-
- -- In our usage list we record
- --
- -- a) Specifically: Detailed version info for imports
- -- from modules in this package Gotten from iVSlurp plus
- -- import_all_mods
- --
- -- b) Everything: Just the module version for imports
- -- from modules in other packages Gotten from iVSlurp plus
- -- import_all_mods
- --
- -- c) NothingAtAll: The name only of modules, Baz, in
- -- this package that are 'below' us, but which we didn't need
- -- at all (this is needed only to decide whether to open Baz.hi
- -- or Baz.hi-boot higher up the tree). This happens when a
- -- module, Foo, that we explicitly imported has 'import Baz' in
- -- its interface file, recording that Baz is below Foo in the
- -- module dependency hierarchy. We want to propagate this
- -- info. These modules are in a combination of HIT/PIT and
- -- iImpModInfo
- --
- -- d) NothingAtAll: The name only of all orphan modules
- -- we know of (this is needed so that anyone who imports us can
- -- find the orphan modules) These modules are in a combination
- -- of HIT/PIT and iImpModInfo
-
- import_info0 = foldModuleEnv mk_imp_info [] pit
- import_info1 = foldModuleEnv (mk_imp_info . hm_iface) import_info0 hpt
- import_info = not_even_opened_imports ++ import_info1
-
- -- Recall that iImpModInfo describes modules that have
- -- been mentioned in the import lists of interfaces we
- -- have seen mentioned, but which we have not even opened when
- -- compiling this module
- not_even_opened_imports =
- [ (mod_name, orphans, is_boot, NothingAtAll)
- | (mod_name, (orphans, is_boot)) <- fmToList (eps_imp_mods eps)]
-
-
- mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
- mk_imp_info iface so_far
-
- | Just ns <- lookupModuleEnv mv_map mod -- Case (a)
- = go_for_it (Specifically mod_vers maybe_export_vers
- (mk_import_items ns) rules_vers)
-
- | mod `elemModuleSet` pkg_mods -- Case (b)
- = go_for_it (Everything mod_vers)
-
- | import_all_mod -- Case (a) and (b); the import-all part
- = if is_home_pkg_mod then
- go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
- -- Since the module isn't in the mv_map, presumably we
- -- didn't actually import anything at all from it
- else
- go_for_it (Everything mod_vers)
-
- | is_home_pkg_mod || has_orphans -- Case (c) or (d)
- = go_for_it NothingAtAll
-
- | otherwise = so_far
- where
- go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
-
- mod = mi_module iface
- mod_name = moduleName mod
- is_home_pkg_mod = isHomeModule mod
- version_info = mi_version iface
- version_env = vers_decls version_info
- mod_vers = vers_module version_info
- rules_vers = vers_rules version_info
- export_vers = vers_exports version_info
- import_all_mod = mod_name `elem` import_all_mods
- has_orphans = mi_orphan iface
-
- -- The sort is to put them into canonical order
- mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
- let v = lookupVersion version_env n
- ]
- where
- lt_occ n1 n2 = nameOccName n1 < nameOccName n2
-
- maybe_export_vers | import_all_mod = Just (vers_exports version_info)
- | otherwise = Nothing
- in
-
- -- seq the list of ImportVersions returned: occasionally these
+ (ImportAvails { imp_mods = dir_imp_mods,
+ dep_mods = dep_mods })
+ used_names
+ = -- seq the list of Usages returned: occasionally these
-- don't get evaluated for a while and we can end up hanging on to
-- the entire collection of Ifaces.
- import_info `seqList` import_info
+ usages `seqList` usages
+ where
+ usages = catMaybes (map mkUsage (moduleEnvElts hpt))
+ hpt = hsc_HPT hsc_env
+
+ import_all mod = case lookupModuleEnv dir_imp_mods mod of
+ Just (_,imp_all) -> imp_all
+ Nothing -> False
+
+ -- Find out whether this module is an
+ is_orphan_mod mod = case lookupModuleEnv dep_mods mod of
+ Just (_, orph, _) -> orph
+ Nothing -> False
+
+ -- ent_map groups together all the things imported and used
+ -- from a particular module in this package
+ ent_map :: ModuleEnv [Name]
+ ent_map = foldNameSet add_mv emptyModuleEnv used_names
+ add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
+ where
+ mod = nameModule name
+ add_item names _ = name:names
+
+ -- We want to create a Usage for a home module if
+ -- a) we used something from; has something in used_names
+ -- b) we imported all of it, even if we used nothing from it
+ -- (need to recompile if its export list changes: export_vers)
+ -- c) is a home-package orphan module (need to recompile if its
+ -- instance decls change: rules_vers)
+ mkUsage :: HomeModInfo -> Maybe (Usage Name)
+ mkUsage mod_info
+ | null used_names
+ && not all_imported
+ && not orphan_mod
+ = Nothing
+
+ | otherwise
+ = Just (Usage { usg_name = moduleName mod,
+ usg_mod = mod_vers,
+ usg_exports = export_vers,
+ usg_entities = ent_vers,
+ usg_rules = rules_vers })
+ where
+ iface = hm_iface mod_info
+ mod = mi_module iface
+ version_info = mi_version iface
+ orphan_mod = mod `elemModuleEnv` dep_mods && mi_orphan iface
+ -- Only bother if the module is below
+ -- us in the import graph
+ version_env = vers_decls version_info
+ mod_vers = vers_module version_info
+ rules_vers = vers_rules version_info
+ all_imported = import_all mod
+ export_vers | all_imported = Just (vers_exports version_info)
+ | otherwise = Nothing
+
+ -- The sort is to put them into canonical order
+ used_names = lookupModuleEnv ent_map mod `orElse` []
+ ent_vers = [(n, lookupVersion version_env n)
+ | n <- sortLt lt_occ used_names ]
+ lt_occ n1 n2 = nameOccName n1 < nameOccName n2
\end{code}
\begin{code}
no_export_change = mi_exports old_iface == mi_exports new_iface -- Kept sorted
no_rule_change = dcl_rules old_decls == dcl_rules new_decls -- Ditto
+ && dcl_insts old_decls == dcl_insts new_decls
no_deprec_change = old_deprecs == new_deprecs
-- Fill in the version number on the new declarations by looking at the old declarations.
<+> ptext SLIT("where")
, pprExports nameOccName (mi_exports iface)
+ , pprDeps (mi_deps iface)
, pprUsages nameOccName (mi_usages iface)
, pprFixities (mi_fixities iface) (dcl_tycl decls)
\begin{code}
-pprUsages :: (a -> OccName) -> [ImportVersion a] -> SDoc
+pprUsages :: (a -> OccName) -> [Usage a] -> SDoc
pprUsages getOcc usages = vcat (map (pprUsage getOcc) usages)
-pprUsage :: (a -> OccName) -> ImportVersion a -> SDoc
-pprUsage getOcc (m, has_orphans, is_boot, whats_imported)
- = hsep [ptext SLIT("import"), ppr m,
- pp_orphan, pp_boot,
- pp_versions whats_imported
+pprUsage :: (a -> OccName) -> Usage a -> SDoc
+pprUsage getOcc usage
+ = hsep [ptext SLIT("import"), ppr (usg_name usage),
+ int (usg_mod usage),
+ pp_export_version (usg_exports usage),
+ int (usg_rules usage),
+ pp_versions (usg_entities usage)
] <> semi
where
- pp_orphan | has_orphans = char '!'
- | otherwise = empty
- pp_boot | is_boot = char '@'
- | otherwise = empty
-
- -- Importing the whole module is indicated by an empty list
- pp_versions NothingAtAll = empty
- pp_versions (Everything v) = dcolon <+> int v
- pp_versions (Specifically vm ve nvs vr) =
- dcolon <+> int vm <+> pp_export_version ve <+> int vr
- <+> hsep [ ppr (getOcc n) <+> int v | (n,v) <- nvs ]
+ pp_versions nvs = hsep [ ppr (getOcc n) <+> int v | (n,v) <- nvs ]
pp_export_version Nothing = empty
pp_export_version (Just v) = int v
+
+
+pprDeps :: Dependencies -> SDoc
+pprDeps (mods, pkgs)
+ = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
+ ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs)]
+ where
+ ppr_mod (mod_name, orph, boot)
+ = ppr mod_name <+> ppr_orphan orph <+> ppr_boot boot
+
+ ppr_orphan True = char '!'
+ ppr_orphan False = empty
+ ppr_boot True = char '@'
+ ppr_boot False = empty
\end{code}
\begin{code}
PackageName, -- Instance of Outputable
mkPackageName, packageNameString,
- preludePackage, rtsPackage, haskell98Package, -- :: PackageName
+ basePackage, rtsPackage, haskell98Package, thPackage, -- :: PackageName
PackageConfigMap, emptyPkgMap, extendPkgMap, lookupPkg
)
packageNameString :: PackageName -> String
packageNameString = unpackFS
-rtsPackage, preludePackage, haskell98Package :: PackageName
-preludePackage = FSLIT("base")
+rtsPackage, basePackage, haskell98Package, thPackage :: PackageName
+basePackage = FSLIT("base")
rtsPackage = FSLIT("rts")
haskell98Package = FSLIT("haskell98")
+thPackage = FSLIT("haskell-src") -- Template Haskell libraries in here
packageDependents :: PackageConfig -> [PackageName]
-- Impedence matcher, because PackageConfig has Strings
import Name ( getOccName, nameOccName, mkInternalName, mkExternalName,
localiseName, isExternalName, nameSrcLoc
)
+import RnEnv ( lookupOrigNameCache, newExternalName )
import NameEnv ( filterNameEnv )
import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
import Type ( tidyTopType )
-- Similarly, we must make sure it has a system-wide Unique, because
-- the byte-code generator builds a system-wide Name->BCO symbol table
- | local && external = case lookupFM ns_names key of
+ | local && external = case lookupOrigNameCache ns_names mod occ' of
Just orig -> (ns, occ_env', orig)
Nothing -> (ns_w_global, occ_env', new_external_name)
-- If we want to externalise a currently-local name, check
global = isExternalName name
local = not global
internal = not external
+ loc = nameSrcLoc name
(occ_env', occ') = tidyOccName occ_env (nameOccName name)
- key = (moduleName mod, occ')
+
ns_names = nsNames ns
- ns_uniqs = nsUniqs ns
- (us1, us2) = splitUniqSupply ns_uniqs
+ (us1, us2) = splitUniqSupply (nsUniqs ns)
uniq = uniqFromSupply us1
- loc = nameSrcLoc name
-
- new_local_name = mkInternalName uniq occ' loc
- new_external_name = mkExternalName uniq mod occ' loc
-
+ new_local_name = mkInternalName uniq occ' loc
ns_w_local = ns { nsUniqs = us2 }
- ns_w_global = ns { nsUniqs = us2, nsNames = addToFM ns_names key new_external_name }
+
+ (ns_w_global, new_external_name) = newExternalName ns mod occ' loc
------------ Worker --------------
{- -*-haskell-*-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.111 2002/10/23 14:30:01 simonpj Exp $
+$Id: Parser.y,v 1.112 2002/10/24 14:17:50 simonpj Exp $
Haskell grammar.
pi_vers = 1, -- Module version
pi_orphan = False,
pi_exports = (1,[($2,mkIfaceExports $4)]),
+ pi_deps = ([],[]),
pi_usages = [],
pi_fixity = [],
pi_insts = [],
\section[PrelNames]{Definitions of prelude modules and names}
-The strings identify built-in prelude modules. They are
-defined here so as to avod
+Nota Bene: all Names defined in here should come from the base package
* ModuleNames for prelude modules,
e.g. pREL_BASE_Name :: ModuleName
#include "HsVersions.h"
-import Module ( ModuleName, mkPrelModule, mkHomeModule, mkModuleName,mkVanillaModule )
-import OccName ( UserFS, dataName, tcName, clsName,
+import Module ( ModuleName, mkBasePkgModule, mkHomeModule, mkModuleName )
+import OccName ( UserFS, dataName, tcName, clsName, varName,
mkKindOccFS, mkOccFS
)
-
--- to avoid clashes with Meta.var we must make a local alias for OccName.varName
--- we do this by removing varName from the import of OccName above, making
--- a qualified instance of OccName and using OccNameAlias.varName where varName
--- ws previously used in this file.
-import qualified OccName as OccNameAlias
-
import RdrName ( RdrName, nameRdrName, mkOrig, rdrNameOcc )
import Unique ( Unique, Uniquable(..), hasKey,
This *local* name is used by the interactive stuff
\begin{code}
-itName uniq = mkInternalName uniq (mkOccFS OccNameAlias.varName FSLIT("it")) noSrcLoc
+itName uniq = mkInternalName uniq (mkOccFS varName FSLIT("it")) noSrcLoc
\end{code}
\begin{code}
gLA_EXTS_Name = mkModuleName "GHC.Exts"
-gHC_PRIM = mkPrelModule gHC_PRIM_Name
-pREL_BASE = mkPrelModule pREL_BASE_Name
-pREL_ADDR = mkPrelModule pREL_ADDR_Name
-pREL_PTR = mkPrelModule pREL_PTR_Name
-pREL_STABLE = mkPrelModule pREL_STABLE_Name
-pREL_IO_BASE = mkPrelModule pREL_IO_BASE_Name
-pREL_PACK = mkPrelModule pREL_PACK_Name
-pREL_ERR = mkPrelModule pREL_ERR_Name
-pREL_NUM = mkPrelModule pREL_NUM_Name
-pREL_REAL = mkPrelModule pREL_REAL_Name
-pREL_FLOAT = mkPrelModule pREL_FLOAT_Name
-pRELUDE = mkPrelModule pRELUDE_Name
+gHC_PRIM = mkBasePkgModule gHC_PRIM_Name
+pREL_BASE = mkBasePkgModule pREL_BASE_Name
+pREL_ADDR = mkBasePkgModule pREL_ADDR_Name
+pREL_PTR = mkBasePkgModule pREL_PTR_Name
+pREL_STABLE = mkBasePkgModule pREL_STABLE_Name
+pREL_IO_BASE = mkBasePkgModule pREL_IO_BASE_Name
+pREL_PACK = mkBasePkgModule pREL_PACK_Name
+pREL_ERR = mkBasePkgModule pREL_ERR_Name
+pREL_NUM = mkBasePkgModule pREL_NUM_Name
+pREL_REAL = mkBasePkgModule pREL_REAL_Name
+pREL_FLOAT = mkBasePkgModule pREL_FLOAT_Name
+pRELUDE = mkBasePkgModule pRELUDE_Name
iNTERACTIVE = mkHomeModule (mkModuleName "$Interactive")
All these are original names; hence mkOrig
\begin{code}
-varQual = mk_known_key_name OccNameAlias.varName -- Note use of local alias vName
+varQual = mk_known_key_name varName
dataQual = mk_known_key_name dataName
tcQual = mk_known_key_name tcName
clsQual = mk_known_key_name clsName
-wVarQual = mk_wired_in_name OccNameAlias.varName -- The wired-in analogues
+wVarQual = mk_wired_in_name varName -- The wired-in analogues
wDataQual = mk_wired_in_name dataName
wTcQual = mk_wired_in_name tcName
-varQual_RDR mod str = mkOrig mod (mkOccFS OccNameAlias.varName str) -- note use of local alias vName
+varQual_RDR mod str = mkOrig mod (mkOccFS varName str) -- note use of local alias vName
tcQual_RDR mod str = mkOrig mod (mkOccFS tcName str)
clsQual_RDR mod str = mkOrig mod (mkOccFS clsName str)
dataQual_RDR mod str = mkOrig mod (mkOccFS dataName str)
mk_known_key_name space mod str uniq
- = mkKnownKeyExternalName mod (mkOccFS space str) uniq
+ = mkKnownKeyExternalName (mkBasePkgModule mod) (mkOccFS space str) uniq
mk_wired_in_name space mod str uniq
- = mkWiredInName (mkVanillaModule mod) (mkOccFS space str) uniq
+ = mkWiredInName (mkBasePkgModule mod) (mkOccFS space str) uniq
kindQual str uq = mkInternalName uq (mkKindOccFS tcName str) noSrcLoc
-- Kinds are not z-encoded in interface file, hence mkKindOccFS
-- others:
import Constants ( mAX_TUPLE_SIZE )
-import Module ( mkPrelModule )
+import Module ( mkBasePkgModule )
import Name ( Name, nameUnique, nameOccName,
nameModule, mkWiredInName )
import OccName ( mkOccFS, tcName, dataName, mkWorkerOcc, mkGenOcc1, mkGenOcc2 )
name = mkWiredInName mod (mkOccFS dataName name_str) dc_uniq
tc_uniq = mkTupleTyConUnique boxity arity
dc_uniq = mkTupleDataConUnique boxity arity
- mod = mkPrelModule mod_name
+ mod = mkBasePkgModule mod_name
gen_info = mk_tc_gen_info mod tc_uniq tc_name tycon
unitTyCon = tupleTyCon Boxed 0
nameStr = mkFastString ("MkPArr" ++ show arity)
name = mkWiredInName mod (mkOccFS dataName nameStr) uniq
uniq = mkPArrDataConUnique arity
- mod = mkPrelModule pREL_PARR_Name
+ mod = mkBasePkgModule pREL_PARR_Name
-- checks whether a data constructor is a fake constructor for parallel arrays
--
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..),
GenAvailInfo(..), AvailInfo, Avails,
- ModIface(..), NameCache(..),
+ ModIface(..), NameCache(..), OrigNameCache,
Deprecations(..), lookupDeprec, isLocalGRE,
extendLocalRdrEnv, availName, availNames,
lookupFixity
)
import TcRnMonad
import Name ( Name, getName, getSrcLoc, nameIsLocalOrFrom, isWiredInName,
- mkInternalName, mkExternalName, mkIPName,
+ mkInternalName, mkExternalName, mkIPName, nameSrcLoc,
nameOccName, setNameModuleAndLoc, nameModule )
import NameSet
import OccName ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour )
-import Module ( Module, ModuleName, moduleName, mkVanillaModule )
+import Module ( Module, ModuleName, moduleName, mkHomeModule,
+ lookupModuleEnv, lookupModuleEnvByName, extendModuleEnv_C )
import PrelNames ( mkUnboundName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
import DsMeta ( templateHaskellNames, qTyConName )
#endif
import TysWiredIn ( unitTyCon ) -- A little odd
+import Finder ( findModule )
import FiniteMap
import UniqSupply
-import SrcLoc ( SrcLoc, noSrcLoc )
+import SrcLoc ( SrcLoc, noSrcLoc, importedSrcLoc )
import Outputable
import ListSetOps ( removeDups, equivClasses )
import BasicTypes ( mapIPName, FixitySig(..) )
= returnM name
| otherwise
+ = newGlobalName mod (rdrNameOcc rdr_name) loc
+
+newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name
+newGlobalName mod occ loc
= -- First check the cache
getNameCache `thenM` \ name_supply ->
- let
- occ = rdrNameOcc rdr_name
- key = (moduleName mod, occ)
- cache = nsNames name_supply
- in
- case lookupFM cache key of
-
- -- A hit in the cache! We are at the binding site of the name, and
- -- this is the moment when we know all about
- -- a) the Name's host Module (in particular, which
- -- package it comes from)
- -- b) its defining SrcLoc
- -- So we update this info
-
- Just name
- | isWiredInName name -> returnM name
- -- Don't mess with wired-in names. Apart from anything
- -- else, their wired-in-ness is in the SrcLoca
- | otherwise
- -> let
- new_name = setNameModuleAndLoc name mod loc
- new_cache = addToFM cache key new_name
- in
- setNameCache (name_supply {nsNames = new_cache}) `thenM_`
- returnM new_name
+ case lookupOrigNameCache (nsNames name_supply) mod occ of
+
+ -- A hit in the cache! We are at the binding site of the name.
+ -- This is the moment when we know the defining SrcLoc
+ -- of the Name. However, since we must have encountered an
+ -- occurrence before the binding site, this must be an
+ -- implicitly-imported name and we can't give a useful SrcLoc to
+ -- it. So we just leave it alone.
+ --
+ -- IMPORTANT: don't mess with wired-in names.
+ -- Their wired-in-ness is in the SrcLoc
+
+ Just name -> returnM name
-- Miss in the cache!
-- Build a completely new Name, and put it in the cache
- -- Even for locally-defined names we use implicitImportProvenance;
- -- updateProvenances will set it to rights
- Nothing -> addNewName name_supply key mod occ loc
-
-newGlobalName :: ModuleName -> OccName -> TcRn m Name
- -- Used for *occurrences*. We make a place-holder Name, really just
- -- to agree on its unique, which gets overwritten when we read in
- -- the binding occurence later (newTopBinder)
- -- The place-holder Name doesn't have the right SrcLoc, and its
- -- Module won't have the right Package either.
- --
- -- (We have to pass a ModuleName, not a Module, because we may be
- -- simply looking at an occurrence M.x in an interface file.)
- --
- -- This means that a renamed program may have incorrect info
- -- on implicitly-imported occurrences, but the correct info on the
- -- *binding* declaration. It's the type checker that propagates the
- -- correct information to all the occurrences.
- -- Since implicitly-imported names never occur in error messages,
- -- it doesn't matter that we get the correct info in place till later,
- -- (but since it affects DLL-ery it does matter that we get it right
- -- in the end).
-newGlobalName mod_name occ
- = getNameCache `thenM` \ name_supply ->
- let
- key = (mod_name, occ)
- cache = nsNames name_supply
- in
- case lookupFM cache key of
- Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenM_`
- returnM name
-
- Nothing -> -- traceRn (text "newGlobalName: new" <+> ppr name) `thenM_`
- addNewName name_supply key (mkVanillaModule mod_name) occ noSrcLoc
+ Nothing -> addNewName name_supply mod occ loc
-- Look up a "system name" in the name cache.
-- This is done by the type checker...
--- For *source* declarations, this will put the thing into the name cache
--- For *interface* declarations, RnHiFiles.getSysBinders will already have
--- put it into the cache.
lookupSysName :: Name -- Base name
-> (OccName -> OccName) -- Occurrence name modifier
-> TcRn m Name -- System name
lookupSysName base_name mk_sys_occ
+ = newGlobalName (nameModule base_name)
+ (mk_sys_occ (nameOccName base_name))
+ (nameSrcLoc base_name)
+
+
+newGlobalNameFromRdrName rdr_name -- Qualified original name
+ = newGlobalName2 (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
+
+newGlobalName2 :: ModuleName -> OccName -> TcRn m Name
+ -- This one starts with a ModuleName, not a Module, because
+ -- we may be simply looking at an occurrence M.x in an interface file.
+ --
+ -- Used for *occurrences*. Even if we get a miss in the
+ -- original-name cache, we make a new External Name.
+ -- We get its Module either from the OrigNameCache, or (if this
+ -- is the first Name from that module) from the Finder
+ --
+ -- In the case of a miss, we have to make up the SrcLoc, but that's
+ -- OK: it must be an implicitly-imported Name, and that never occurs
+ -- in an error message.
+
+newGlobalName2 mod_name occ
= getNameCache `thenM` \ name_supply ->
let
- mod = nameModule base_name
- occ = mk_sys_occ (nameOccName base_name)
- key = (moduleName mod, occ)
+ new_name mod = addNewName name_supply mod occ importedSrcLoc
in
- case lookupFM (nsNames name_supply) key of
- Just name -> returnM name
- Nothing -> addNewName name_supply key mod occ noSrcLoc
+ case lookupModuleEnvByName (nsNames name_supply) mod_name of
+ Just (mod, occ_env) ->
+ -- There are some names from this module already
+ -- Next, look up in the OccNameEnv
+ case lookupFM occ_env occ of
+ Just name -> returnM name
+ Nothing -> new_name mod
+
+ Nothing -> -- No names from this module yet
+ ioToTcRn (findModule mod_name) `thenM` \ mb_loc ->
+ case mb_loc of
+ Just (mod, _) -> new_name mod
+ Nothing -> addErr (noModule mod_name) `thenM_`
+ -- Things have really gone wrong at this point,
+ -- so having the wrong package info in the
+ -- Module is the least of our worries.
+ new_name (mkHomeModule mod_name)
+ where
+ noModule mod_name = ptext SLIT("Can't find interface for module") <+> ppr mod_name
+
newIPName rdr_name_ip
= getNameCache `thenM` \ name_supply ->
where
key = rdr_name_ip -- Ensures that ?x and %x get distinct Names
-addNewName :: NameCache -> (ModuleName,OccName)
- -> Module -> OccName -> SrcLoc -> TcRn m Name
--- Internal function: extend the name cache, dump it back into
--- the monad, and return the new name
--- (internal, hence the rather redundant interface)
-addNewName name_supply key mod occ loc
+-- A local helper function
+addNewName name_supply mod occ loc
= setNameCache new_name_supply `thenM_`
returnM name
where
- (us', us1) = splitUniqSupply (nsUniqs name_supply)
- uniq = uniqFromSupply us1
- name = mkExternalName uniq mod occ loc
- new_cache = addToFM (nsNames name_supply) key name
+ (new_name_supply, name) = newExternalName name_supply mod occ loc
+
+
+newExternalName :: NameCache -> Module -> OccName -> SrcLoc
+ -> (NameCache,Name)
+-- Allocate a new unique, manufacture a new External Name,
+-- put it in the cache, and return the two
+newExternalName name_supply mod occ loc
+ = (new_name_supply, name)
+ where
+ (us', us1) = splitUniqSupply (nsUniqs name_supply)
+ uniq = uniqFromSupply us1
+ name = mkExternalName uniq mod occ loc
+ new_cache = extend_name_cache (nsNames name_supply) mod occ name
new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
+
+lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
+lookupOrigNameCache nc mod occ
+ = case lookupModuleEnv nc mod of
+ Nothing -> Nothing
+ Just (_, occ_env) -> lookupFM occ_env occ
+
+extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
+extendOrigNameCache nc name
+ = extend_name_cache nc (nameModule name) (nameOccName name) name
+
+extend_name_cache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
+extend_name_cache nc mod occ name
+ = extendModuleEnv_C combine nc mod (mod, unitFM occ name)
+ where
+ combine (mod, occ_env) _ = (mod, addToFM occ_env occ name)
\end{code}
%*********************************************************
= returnM (Just name)
| isOrig rdr_name -- An original name
- = newGlobalName (rdrNameModule rdr_name)
- (rdrNameOcc rdr_name) `thenM` \ name ->
+ = newGlobalNameFromRdrName rdr_name `thenM` \ name ->
returnM (Just name)
| otherwise
-- unqualified names for locally-defined things, such as
-- constructors of a data type.
lookupIfaceName mod rdr_name
- | isUnqual rdr_name = newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
+ | isUnqual rdr_name = newGlobalName mod (rdrNameOcc rdr_name) importedSrcLoc
| otherwise = lookupOrigName rdr_name
lookupOrigName :: RdrName -> TcRn m Name
| otherwise -- Usually Orig, but can be a Qual when
-- we are reading a .hi-boot file
- = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
+ = newGlobalNameFromRdrName rdr_name
dataTcOccs :: RdrName -> [RdrName]
import Parser ( parseIface )
import HscTypes ( ModIface(..), emptyModIface,
ExternalPackageState(..),
- VersionInfo(..), ImportedModuleInfo,
- lookupIfaceByModName, RdrExportItem, WhatsImported(..),
- ImportVersion, WhetherHasOrphans, IsBootInterface,
+ VersionInfo(..), Usage(..),
+ lookupIfaceByModName, RdrExportItem,
+ WhetherHasOrphans, IsBootInterface,
DeclsMap, GatedDecl, IfaceInsts, IfaceRules, mkIfaceDecls,
AvailInfo, GenAvailInfo(..), ParsedIface(..), IfaceDeprecs,
Avails, availNames, availName, Deprecations(..)
import NameSet
import Id ( idName )
import MkId ( seqId )
-import Packages ( preludePackage )
+import Packages ( basePackage )
import Module ( Module, ModuleName, ModLocation(ml_hi_file),
- moduleName, isHomeModule, mkVanillaModule,
- extendModuleEnv
+ moduleName, isHomeModule, mkPackageModule,
+ extendModuleEnv, lookupModuleEnvByName
)
import RdrName ( RdrName, mkRdrUnqual, rdrNameOcc, nameRdrName )
import OccName ( OccName, mkWorkerOcc, mkClassTyConOcc, mkClassDataConOcc,
-- But it's OK to fail; perhaps the module has changed, and that interface
-- is no longer used.
- -- tryLoadInterface guarantees to return with eps_mod_info m --> (..., True)
- -- (If the load fails, we plug in a vanilla placeholder)
loadInterface doc_str mod_name from
- = getHpt `thenM` \ hpt ->
- getModule `thenM` \ this_mod ->
- getEps `thenM` \ eps@(EPS { eps_PIT = pit }) ->
+ = getHpt `thenM` \ hpt ->
+ getModule `thenM` \ this_mod ->
+ getImports `thenM` \ import_avails ->
+ getEps `thenM` \ eps@(EPS { eps_PIT = pit }) ->
-- CHECK WHETHER WE HAVE IT ALREADY
case lookupIfaceByModName hpt pit mod_name of {
-- before we got to real imports.
other ->
+ traceRn (vcat [text "loadInterface" <+> brackets doc_str,
+ ppr (dep_mods import_avails)]) `thenM_`
let
- mod_map = eps_imp_mods eps
- mod_info = lookupFM mod_map mod_name
+ mod_map = dep_mods import_avails
+ mod_info = lookupModuleEnvByName mod_map mod_name
hi_boot_file
= case (from, mod_info) of
- (ImportByUser is_boot, _) -> is_boot
- (ImportForUsage is_boot, _) -> is_boot
- (ImportBySystem, Just (_, is_boot)) -> is_boot
- (ImportBySystem, Nothing) -> False
+ (ImportByUser is_boot, _) -> is_boot
+ (ImportForUsage is_boot, _) -> is_boot
+ (ImportBySystem, Just (_, _, is_boot)) -> is_boot
+ (ImportBySystem, Nothing) -> False
-- We're importing a module we know absolutely
-- nothing about, so we assume it's from
-- another package, where we aren't doing
redundant_source_import
= case (from, mod_info) of
- (ImportByUser True, Just (_,False)) -> True
- other -> False
+ (ImportByUser True, Just (_, _, False)) -> True
+ other -> False
in
-- Issue a warning for a redundant {- SOURCE -} import
| otherwise
-> let -- Not found, so add an empty export env to
-- the EPS map so that we don't look again
- fake_mod = mkVanillaModule mod_name
+ fake_mod = mkPackageModule mod_name
fake_iface = emptyModIface fake_mod
new_eps = eps { eps_PIT = extendModuleEnv pit fake_mod fake_iface }
in
vers_rules = rule_vers,
vers_decls = decls_vers }
- -- Add to mod_map info about the things the imported module
- -- depends on, extracted from its usage info
- -- No point for system imports, for reasons that escape me...
- usages = pi_usages iface
- mod_map1 = case from of
- ImportBySystem -> mod_map
- other -> addModDeps mod is_loaded usages mod_map
- -- Delete the module itself, which is now in the PIT
- mod_map2 = delFromFM mod_map1 mod_name
-
- -- mod_deps is a pruned version of usages that records only what
- -- module imported, but nothing about versions.
- -- This info is used when demand-linking the dependencies
- mod_deps = [ (mod,orph,boot,NothingAtAll) | (mod,orph,boot,_) <- usages]
-
this_mod_name = moduleName this_mod
is_loaded m = m == this_mod_name
|| maybeToBool (lookupIfaceByModName hpt pit m)
mi_orphan = has_orphans, mi_boot = hi_boot_file,
mi_exports = avails,
mi_fixities = fix_env, mi_deprecs = deprec_env,
- mi_usages = mod_deps, -- Used for demand-loading,
- -- not for version info
+ mi_deps = pi_deps iface,
+ mi_usages = panic "No mi_usages in PIT",
mi_decls = panic "No mi_decls in PIT",
mi_globals = Nothing
}
new_eps = eps { eps_PIT = new_pit,
eps_decls = new_decls,
eps_insts = new_insts,
- eps_rules = new_rules,
- eps_imp_mods = mod_map2 }
+ eps_rules = new_rules }
in
setEps new_eps `thenM_`
returnM mod_iface
}}
-----------------------------------------------------
--- Adding module dependencies from the
--- import decls in the interface file
------------------------------------------------------
-
-addModDeps :: Module
- -> (ModuleName -> Bool) -- True for modules that are already loaded
- -> [ImportVersion a]
- -> ImportedModuleInfo -> ImportedModuleInfo
--- (addModDeps M ivs deps)
--- We are importing module M, and M.hi contains 'import' decls given by ivs
-addModDeps mod is_loaded new_deps mod_deps
- = foldr add mod_deps filtered_new_deps
- where
- -- Don't record dependencies when importing a module from another package
- -- Except for its descendents which contain orphans,
- -- and in that case, forget about the boot indicator
- filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
- filtered_new_deps
- | isHomeModule mod = [ (imp_mod, (has_orphans, is_boot))
- | (imp_mod, has_orphans, is_boot, _) <- new_deps,
- not (is_loaded imp_mod)
- ]
- | otherwise = [ (imp_mod, (True, False))
- | (imp_mod, has_orphans, _, _) <- new_deps,
- not (is_loaded imp_mod) && has_orphans
- ]
- add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep
-
- combine old@(old_has_orphans, old_is_boot) new@(new_has_orphans, new_is_boot)
- | old_is_boot = new -- Record the best is_boot info
- | otherwise = old
-
------------------------------------------------------
-- Loading the export list
-----------------------------------------------------
returnM (mod, avails)
where
load_entity mod (Avail occ)
- = newGlobalName mod occ `thenM` \ name ->
+ = newGlobalName2 mod occ `thenM` \ name ->
returnM (Avail name)
load_entity mod (AvailTC occ occs)
- = newGlobalName mod occ `thenM` \ name ->
- mappM (newGlobalName mod) occs `thenM` \ names ->
+ = newGlobalName2 mod occ `thenM` \ name ->
+ mappM (newGlobalName2 mod) occs `thenM` \ names ->
returnM (AvailTC name names)
decls = mkIfaceDecls new_decls new_rules new_insts
mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface,
- mi_version = version,
+ mi_version = version, mi_deps = pi_deps iface,
mi_exports = avails, mi_usages = usages,
mi_boot = False, mi_orphan = pi_orphan iface,
mi_fixities = fix_env, mi_deprecs = deprec_env,
loadHomeInsts insts = mappM rnInstDecl insts
------------------
-loadHomeUsage :: ImportVersion OccName
- -> TcRn m (ImportVersion Name)
-loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
- = rn_imps whats_imported `thenM` \ whats_imported' ->
- returnM (mod_name, orphans, is_boot, whats_imported')
+loadHomeUsage :: Usage OccName -> TcRn m (Usage Name)
+loadHomeUsage usage
+ = mappM rn_imp (usg_entities usage) `thenM` \ entities' ->
+ returnM (usage { usg_entities = entities' })
where
- rn_imps NothingAtAll = returnM NothingAtAll
- rn_imps (Everything v) = returnM (Everything v)
- rn_imps (Specifically mv ev items rv) = mappM rn_imp items `thenM` \ items' ->
- returnM (Specifically mv ev items' rv)
- rn_imp (occ,vers) = newGlobalName mod_name occ `thenM` \ name ->
+ mod_name = usg_name usage
+ rn_imp (occ,vers) = newGlobalName2 mod_name occ `thenM` \ name ->
returnM (name,vers)
\end{code}
ghcPrimIface :: ParsedIface
ghcPrimIface = ParsedIface {
pi_mod = gHC_PRIM_Name,
- pi_pkg = preludePackage,
+ pi_pkg = basePackage,
+ pi_deps = ([],[]),
pi_vers = 1,
pi_orphan = False,
pi_usages = [],
tyClDeclFVs, ruleDeclFVs, impDeclFVs
)
import RnHiFiles ( loadInterface, loadHomeInterface, loadOrphanModules )
+import RnNames ( mkModDeps )
import RnSource ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
import TcEnv ( getInGlobalScope, tcLookupGlobal_maybe )
import TcRnMonad
)
import NameEnv ( delFromNameEnv, lookupNameEnv )
import NameSet
-import Module ( Module, isHomeModule, extendModuleSet )
+import Module ( Module, isHomeModule, extendModuleSet, moduleEnvElts )
import PrelNames ( hasKey, fractionalClassKey, numClassKey,
integerTyConName, doubleTyConName )
import FiniteMap
recordUsage name = updUsages (upd_usg name)
upd_usg name usages
- | isHomeModule mod = usages { usg_home = addOneToNameSet (usg_home usages) name }
- | otherwise = usages { usg_ext = extendModuleSet (usg_ext usages) mod }
+ | isHomeModule mod = addOneToNameSet usages name
+ | otherwise = usages
where
mod = nameModule name
\end{code}
getImportedInstDecls gates
= -- First, load any orphan-instance modules that aren't aready loaded
-- Orphan-instance modules are recorded in the module dependecnies
- getEps `thenM` \ eps ->
+ getImports `thenM` \ imports ->
+ getEps `thenM` \ eps ->
let
old_gates = eps_inst_gates eps
new_gates = gates `minusNameSet` old_gates
all_gates = new_gates `unionNameSets` old_gates
- orphan_mods = [mod | (mod, (True, _)) <- fmToList (eps_imp_mods eps)]
+ orphan_mods = [mod | (mod, True, _) <- moduleEnvElts (dep_mods imports)]
in
loadOrphanModules orphan_mods `thenM_`
= returnM outOfDate
| otherwise
= traceHiDiffs (text "Considering whether compilation is required for" <+>
- ppr (mi_module iface) <> colon) `thenM_`
+ ppr (mi_module iface) <> colon) `thenM_`
-- Source code unchanged and no errors yet... carry on
- checkList [checkModUsage u | u <- mi_usages iface]
+ -- First put the dependent-module info in the envt, just temporarily,
+ -- so that when we look for interfaces we look for the right one.
+ -- It's just temporary because either the usage check will succeed
+ -- (in which case we are done with this module) or it'll fail (in which
+ -- case we'll compile the module from scratch anyhow).
+ updGblEnv (\ gbl -> gbl { tcg_imports = mod_deps }) (
+ checkList [checkModUsage u | u <- mi_usages iface]
+ )
+
+ where
+ -- This is a bit of a hack really
+ mod_deps = emptyImportAvails { dep_mods = mkModDeps (fst (mi_deps iface)) }
checkList :: [TcRn m RecompileRequired] -> TcRn m RecompileRequired
checkList [] = returnM upToDate
\end{code}
\begin{code}
-checkModUsage :: ImportVersion Name -> TcRn m RecompileRequired
+checkModUsage :: Usage Name -> TcRn m RecompileRequired
-- Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.
-checkModUsage (mod_name, _, _, NothingAtAll)
- -- If CurrentModule.hi contains
- -- import Foo :: ;
- -- then that simply records that Foo lies below CurrentModule in the
- -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
- -- In this case we don't even want to open Foo's interface.
- = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
-
-checkModUsage (mod_name, _, is_boot, whats_imported)
+checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
+ usg_rules = old_rule_vers,
+ usg_exports = maybe_old_export_vers,
+ usg_entities = old_decl_vers })
= -- Load the imported interface is possible
- -- We use tryLoadInterface, because failure is not an error
- -- (might just be that the old .hi file for this module is out of date)
let
doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
- from = ImportForUsage is_boot
in
traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
- tryM (loadInterface doc_str mod_name from) `thenM` \ mb_iface ->
+ tryM (loadInterface doc_str mod_name ImportBySystem) `thenM` \ mb_iface ->
case mb_iface of {
Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
new_export_vers = vers_exports new_vers
new_rule_vers = vers_rules new_vers
in
- case whats_imported of { -- NothingAtAll dealt with earlier
-
- Everything old_mod_vers -> checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
- if recompile then
- out_of_date (ptext SLIT("...and I needed the whole module"))
- else
- returnM upToDate ;
-
- Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
-
-- CHECK MODULE
checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
if not recompile then
else
up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
- }}
+ }
------------------------
checkModuleVersion old_mod_vers new_mod_vers
\begin{code}
module RnNames (
rnImports, importsFromLocalDecls, exportsFromAvail,
- reportUnusedNames
+ reportUnusedNames, mkModDeps
) where
#include "HsVersions.h"
import FiniteMap
import PrelNames ( pRELUDE_Name, mAIN_Name, isBuiltInSyntaxName )
-import Module ( Module, ModuleName, moduleName,
- moduleNameUserString,
- unitModuleEnvByName, lookupModuleEnvByName,
- moduleEnvElts )
+import Module ( Module, ModuleName, ModuleEnv, moduleName,
+ moduleNameUserString, isHomeModule,
+ emptyModuleEnv, unitModuleEnvByName, unitModuleEnv,
+ lookupModuleEnvByName, extendModuleEnvByName, moduleEnvElts )
import Name ( Name, nameSrcLoc, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
import OccName ( OccName, dataName, isTcOcc )
import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv,
- GenAvailInfo(..), AvailInfo, Avails, IsBootInterface,
+ GenAvailInfo(..), AvailInfo, Avails,
+ IsBootInterface, WhetherHasOrphans,
availName, availNames, availsToNameSet,
Deprecations(..), ModIface(..),
GlobalRdrElt(..), unQualInScope, isLocalGRE
import Maybes ( maybeToBool, catMaybes )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
-import List ( partition )
+import List ( partition, insert )
import IO ( openFile, IOMode(..) )
\end{code}
(source, ordinary) = partition is_source_import all_imports
is_source_import (ImportDecl _ is_boot _ _ _ _) = is_boot
- get_imports = importsFromImportDecl (moduleName this_mod)
+ get_imports = importsFromImportDecl this_mod
in
mappM get_imports ordinary `thenM` \ stuff1 ->
mappM get_imports source `thenM` \ stuff2 ->
\end{code}
\begin{code}
-importsFromImportDecl :: ModuleName
+importsFromImportDecl :: Module
-> RdrNameImportDecl
-> TcRn m (GlobalRdrEnv, ImportAvails)
-importsFromImportDecl this_mod_name
- (ImportDecl imp_mod_name is_boot qual_only as_mod import_spec iloc)
+importsFromImportDecl this_mod
+ (ImportDecl imp_mod_name is_boot qual_only as_mod imp_spec iloc)
= addSrcLoc iloc $
let
- doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
+ doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
in
-- If there's an error in loadInterface, (e.g. interface
Right iface ->
let
- imp_mod = mi_module iface
+ imp_mod = mi_module iface
avails_by_module = mi_exports iface
- deprecs = mi_deprecs iface
- dir_imp = unitModuleEnvByName imp_mod_name (imp_mod, import_all import_spec)
+ deprecs = mi_deprecs iface
+ is_orph = mi_orphan iface
avails :: Avails
avails = [ avail | (mod_name, avails) <- avails_by_module,
mod_name /= this_mod_name,
avail <- avails ]
+ this_mod_name = moduleName this_mod
-- If the module exports anything defined in this module, just ignore it.
-- Reason: otherwise it looks as if there are two local definition sites
-- for the thing, and an error gets reported. Easiest thing is just to
-- then you'll get a 'B does not export AType' message. Oh well.
in
+ -- Filter the imports according to the import list
+ filterImports imp_mod is_boot imp_spec avails `thenM` \ (filtered_avails, explicits) ->
+
+ let
+ (sub_dep_mods, sub_dep_pkgs) = mi_deps iface
+
+ -- Compute new transitive dependencies: take the ones in
+ -- the interface and add
+ (dependent_mods, dependent_pkgs)
+ | isHomeModule imp_mod
+ = -- Imported module is from the home package
+ -- Take its dependent modules and
+ -- (a) remove this_mod (might be there as a hi-boot)
+ -- (b) add imp_mod itself
+ -- Take its dependent packages unchanged
+ ((imp_mod_name, is_orph, is_boot) : filter not_self sub_dep_mods,
+ sub_dep_pkgs)
+ | otherwise
+ = -- Imported module is from another package
+ -- Take only the orphan modules from its dependent modules
+ -- (sigh! it would be better to dump them entirely)
+ -- Add the package imp_mod comes from to the dependent packages
+ -- from imp_mod
+ (filter sub_is_orph sub_dep_mods,
+ insert (mi_package iface) sub_dep_pkgs)
+
+ not_self (m, _, _) = m /= this_mod_name
+ sub_is_orph (_, orph, _) = orph
+
+ import_all = case imp_spec of
+ (Just (False, _)) -> False -- Imports are spec'd explicitly
+ other -> True -- Everything is imported,
+ -- (or almost everything [hiding])
+
+ qual_mod_name = case as_mod of
+ Nothing -> imp_mod_name
+ Just another_name -> another_name
+
+ -- unqual_avails is the Avails that are visible in *unqualified* form
+ -- We need to know this so we know what to export when we see
+ -- module M ( module P ) where ...
+ -- Then we must export whatever came from P unqualified.
+ avail_env = mkAvailEnv filtered_avails
+ unqual_avails | qual_only = emptyAvailEnv -- Qualified import
+ | otherwise = avail_env -- Unqualified import
+
+ mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
+ gbl_env = mkGlobalRdrEnv qual_mod_name (not qual_only)
+ mk_prov filtered_avails deprecs
+ imports = ImportAvails {
+ imp_unqual = unitModuleEnvByName qual_mod_name unqual_avails,
+ imp_env = avail_env,
+ imp_mods = unitModuleEnv imp_mod (imp_mod, import_all),
+ dep_mods = mkModDeps dependent_mods,
+ dep_pkgs = dependent_pkgs }
+
+ in
-- Complain if we import a deprecated module
ifOptM Opt_WarnDeprecations (
case deprecs of
other -> returnM ()
) `thenM_`
- -- Filter the imports according to the import list
- filterImports imp_mod_name is_boot import_spec avails `thenM` \ (filtered_avails, explicits) ->
-
- let
- unqual_imp = not qual_only -- Maybe want unqualified names
- qual_mod = case as_mod of
- Nothing -> imp_mod_name
- Just another_name -> another_name
-
- mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
- gbl_env = mkGlobalRdrEnv qual_mod unqual_imp mk_prov filtered_avails deprecs
- imports = mkImportAvails qual_mod unqual_imp filtered_avails
- in
- returnM (gbl_env, imports { imp_mods = dir_imp})
+ returnM (gbl_env, imports)
}
-import_all (Just (False, _)) = False -- Imports are spec'd explicitly
-import_all other = True -- Everything is imported
+mkModDeps :: [(ModuleName, WhetherHasOrphans, IsBootInterface)]
+ -> ModuleEnv (ModuleName, WhetherHasOrphans, IsBootInterface)
+mkModDeps deps = foldl add emptyModuleEnv deps
+ where
+ add env elt@(m,_,_) = extendModuleEnvByName env m elt
\end{code}
doptM Opt_NoImplicitPrelude `thenM` \ implicit_prelude ->
let
mod_name = moduleName this_mod
- unqual_imp = True -- Want unqualified names
mk_prov n = LocalDef -- Provenance is local
+ unqual_imp = True -- Want unqualified names in scope
gbl_env = mkGlobalRdrEnv mod_name unqual_imp mk_prov avails NoDeprecs
-- NoDeprecs: don't complain about locally defined names
-- For a start, we may be exporting a deprecated thing
-- but that stops them being Exact, so they get looked up. Sigh.
-- It doesn't matter because it only affects the Data.Tuple really.
-- The important thing is to trim down the exports.
- imports = mkImportAvails mod_name unqual_imp avails'
+
avails' | implicit_prelude = filter not_built_in_syntax avails
| otherwise = avails
not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a))
-- Only filter it if all the names of the avail are built-in
-- In particular, lists have (:) which is not built in syntax
-- so we don't filter it out.
+
+ avail_env = mkAvailEnv avails'
+ imports = emptyImportAvails {
+ imp_unqual = unitModuleEnv this_mod avail_env,
+ imp_env = avail_env
+ }
in
returnM (gbl_env, imports)
\end{code}
available, and filters it through the import spec (if any).
\begin{code}
-filterImports :: ModuleName -- The module being imported
+filterImports :: Module -- The module being imported
-> IsBootInterface -- Tells whether it's a {-# SOURCE #-} import
-> Maybe (Bool, [RdrNameIE]) -- Import spec; True => hiding
-> [AvailInfo] -- What's available
import Id ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported )
import IdInfo ( GlobalIdDetails(..) )
import Var ( Var, setGlobalIdDetails )
-import Module ( Module, moduleName, moduleUserString )
+import Module ( Module, moduleName, moduleUserString, moduleEnvElts )
import Name ( Name, isExternalName, getSrcLoc, nameOccName )
import NameEnv ( delListFromNameEnv )
import NameSet
updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
tcg_imports = tcg_imports gbl `plusImportAvails` imports })
$ do {
- traceRn (text "rn1") ;
+ traceRn (text "rn1" <+> ppr (dep_mods imports)) ;
-- Fail if there are any errors so far
-- The error printing (if needed) takes advantage
-- of the tcg_env we have now set
updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` mod_deprecs })
$ do {
- traceRn (text "Rn4:" <+> ppr (imp_unqual (tcg_imports tcg_env))) ;
-- Process the export list
export_avails <- exportsFromAvail exports ;
updGblEnv (\gbl -> gbl { tcg_exports = export_avails })
mod_guts = ModGuts { mg_module = this_mod,
mg_usages = [], -- ToDo: compute usage
mg_dir_imps = [], -- ??
+ mg_deps = ([],[]), -- ??
mg_exports = my_exports,
mg_types = final_type_env,
mg_insts = tcg_insts tcg_env,
pprTcGblEnv :: TcGblEnv -> SDoc
pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
tcg_insts = dfun_ids,
- tcg_rules = rules })
+ tcg_rules = rules,
+ tcg_imports = imports })
= vcat [ ppr_types dfun_ids type_env
, ppr_insts dfun_ids
, vcat (map ppr rules)
- , ppr_gen_tycons (typeEnvTyCons type_env)]
+ , ppr_gen_tycons (typeEnvTyCons type_env)
+ , ppr (moduleEnvElts (dep_mods imports))
+ , ppr (dep_pkgs imports)]
pprModGuts :: ModGuts -> SDoc
pprModGuts (ModGuts { mg_types = type_env,
GlobalRdrEnv, LocalRdrEnv, NameCache, FixityEnv,
GhciMode, lookupType, unQualInScope )
import TcRnTypes
-import Module ( Module, moduleName, foldModuleEnv )
+import Module ( Module, moduleName, unitModuleEnv, foldModuleEnv )
import Name ( Name, isInternalName )
import Type ( Type )
import NameEnv ( extendNameEnvList )
where
eps = pcs_EPS pcs
- init_imports = mkImportAvails (moduleName mod) True []
+ init_imports = emptyImportAvails { imp_unqual = unitModuleEnv mod emptyAvailEnv }
-- Initialise tcg_imports with an empty set of bindings for
-- this module, so that if we see 'module M' in the export
-- list, and there are no bindings in M, we don't bleat
-- "unknown module M".
-
defaultDefaultTys :: [Type]
defaultDefaultTys = [integerTy, doubleTy]
getGlobalRdrEnv :: TcRn m GlobalRdrEnv
getGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) }
+getImports :: TcRn m ImportAvails
+getImports = do { env <- getGblEnv; return (tcg_imports env) }
+
getFixityEnv :: TcRn m FixityEnv
getFixityEnv = do { env <- getGblEnv; return (tcg_fix_env env) }
\end{code}
\begin{code}
-getUsageVar :: TcRn m (TcRef Usages)
+getUsageVar :: TcRn m (TcRef EntityUsage)
getUsageVar = do { env <- getGblEnv; return (tcg_usages env) }
-getUsages :: TcRn m Usages
+getUsages :: TcRn m EntityUsage
getUsages = do { usg_var <- getUsageVar; readMutVar usg_var }
-updUsages :: (Usages -> Usages) -> TcRn m ()
+updUsages :: (EntityUsage -> EntityUsage) -> TcRn m ()
updUsages upd = do { usg_var <- getUsageVar ;
usg <- readMutVar usg_var ;
writeMutVar usg_var (upd usg) }
-- Ranamer types
RnMode(..), isInterfaceMode, isCmdLineMode,
- Usages(..), emptyUsages, ErrCtxt,
- ImportAvails(..), emptyImportAvails, plusImportAvails, mkImportAvails,
+ EntityUsage, emptyUsages, ErrCtxt,
+ ImportAvails(..), emptyImportAvails, plusImportAvails,
plusAvail, pruneAvails,
- AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, lookupAvailEnv, availEnvElts, addAvail,
+ AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv,
+ mkAvailEnv, lookupAvailEnv, availEnvElts, addAvail,
WhereFrom(..),
-- Typechecker types
import HscTypes ( GhciMode, ExternalPackageState, HomePackageTable, NameCache,
GlobalRdrEnv, LocalRdrEnv, FixityEnv, TypeEnv, TyThing,
Avails, GenAvailInfo(..), AvailInfo, availName,
- IsBootInterface, Deprecations )
+ IsBootInterface, Deprecations, WhetherHasOrphans )
+import Packages ( PackageName )
import TcType ( TcTyVarSet, TcType, TcTauType, TcThetaType, TcPredType, TcKind,
tcCmpPred, tcCmpType, tcCmpTypes )
import InstEnv ( DFunId, InstEnv )
data TcGblEnv
= TcGblEnv {
tcg_mod :: Module, -- Module being compiled
- tcg_usages :: TcRef Usages, -- What version of what entities
- -- have been used from other modules
- -- (whether home or ext-package modules)
+ tcg_usages :: TcRef EntityUsage, -- What version of what entities
+ -- have been used from other home-pkg modules
tcg_rdr_env :: GlobalRdrEnv, -- Top level envt; used during renaming
tcg_fix_env :: FixityEnv, -- Ditto
tcg_default :: [Type], -- Types used for defaulting
%************************************************************************
%* *
- Usages
+ EntityUsage
%* *
%************************************************************************
-Usages tells what things are actually need in order to compile this
-module. It is used
- * for generating the usages field of the ModIface
- * for reporting unused things in scope
+EntityUsage tells what things are actually need in order to compile this
+module. It is used for generating the usage-version field of the ModIface.
-\begin{code}
-data Usages
- = Usages {
- usg_ext :: ModuleSet,
- -- The non-home-package modules from which we have
- -- slurped at least one name.
-
- usg_home :: NameSet
- -- The Names are all the (a) home-package
- -- (b) "big" (i.e. no data cons, class ops)
- -- (c) non-locally-defined
- -- (d) non-wired-in
- -- names that have been slurped in so far.
- -- This is used to generate the "usage" information for this module.
- }
+Note that we do not record version info for entities from
+other (non-home) packages. If the package changes, GHC doesn't help.
-emptyUsages :: Usages
-emptyUsages = Usages { usg_ext = emptyModuleSet,
- usg_home = emptyNameSet }
+\begin{code}
+type EntityUsage = NameSet
+ -- The Names are all the (a) home-package
+ -- (b) "big" (i.e. no data cons, class ops)
+ -- (c) non-locally-defined
+ -- (d) non-wired-in
+ -- names that have been slurped in so far.
+ -- This is used to generate the "usage" information for this module.
+
+emptyUsages :: EntityUsage
+emptyUsages = emptyNameSet
\end{code}
-- combine stuff coming from different (unqualified)
-- imports of the same module
- imp_mods :: ModuleEnv (Module, Bool)
+ imp_mods :: ModuleEnv (Module, Bool),
-- Domain is all directly-imported modules
-- Bool is True if there was an unrestricted import
-- (i.e. not a selective list)
-- the interface file; if we import everything we
-- need to recompile if the module version changes
-- (b) to specify what child modules to initialise
+
+ dep_mods :: ModuleEnv (ModuleName, WhetherHasOrphans, IsBootInterface),
+ -- For a given import or set of imports,
+ -- there's an entry here for
+ -- (a) modules below the one being compiled, in the current package
+ -- (b) orphan modules below the one being compiled, regardless of package
+ --
+ -- It doesn't matter whether any of these dependencies are actually
+ -- *used* when compiling the module; they are listed if they are below
+ -- it at all. For example, suppose M imports A which imports X. Then
+ -- compiling M might not need to consult X.hi, but X is still listed
+ -- in M's dependencies.
+
+ dep_pkgs :: [PackageName]
+ -- Packages needed by the module being compiled, whether
+ -- directly, or via other modules in this package, or via
+ -- modules imported from other packages.
}
emptyImportAvails :: ImportAvails
emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv,
imp_unqual = emptyModuleEnv,
- imp_mods = emptyModuleEnv }
+ imp_mods = emptyModuleEnv,
+ dep_mods = emptyModuleEnv,
+ dep_pkgs = [] }
plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
plusImportAvails
- (ImportAvails { imp_env = env1, imp_unqual = unqual1, imp_mods = mods1 })
- (ImportAvails { imp_env = env2, imp_unqual = unqual2, imp_mods = mods2 })
+ (ImportAvails { imp_env = env1, imp_unqual = unqual1, imp_mods = mods1,
+ dep_mods = dmods1, dep_pkgs = dpkgs1 })
+ (ImportAvails { imp_env = env2, imp_unqual = unqual2, imp_mods = mods2,
+ dep_mods = dmods2, dep_pkgs = dpkgs2 })
= ImportAvails { imp_env = env1 `plusAvailEnv` env2,
imp_unqual = plusModuleEnv_C plusAvailEnv unqual1 unqual2,
- imp_mods = mods1 `plusModuleEnv` mods2 }
-
-mkImportAvails :: ModuleName -> Bool
- -> [AvailInfo] -> ImportAvails
-mkImportAvails mod_name unqual_imp avails
- = ImportAvails { imp_unqual = mod_avail_env,
- imp_env = entity_avail_env,
- imp_mods = emptyModuleEnv }-- Stays empty for module being compiled;
- -- gets updated for imported modules
+ imp_mods = mods1 `plusModuleEnv` mods2,
+ dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2,
+ dep_pkgs = nub (dpkgs1 ++ dpkgs2) }
where
- mod_avail_env = unitModuleEnvByName mod_name unqual_avails
-
- -- unqual_avails is the Avails that are visible in *unqualified* form
- -- We need to know this so we know what to export when we see
- -- module M ( module P ) where ...
- -- Then we must export whatever came from P unqualified.
-
- unqual_avails | not unqual_imp = emptyAvailEnv -- Qualified import
- | otherwise = entity_avail_env -- Unqualified import
-
- entity_avail_env = foldl insert emptyAvailEnv avails
- insert env avail = extendNameEnv_C plusAvail env (availName avail) avail
- -- 'avails' may have several items with the same availName
- -- E.g import Ix( Ix(..), index )
- -- will give Ix(Ix,index,range) and Ix(index)
- -- We want to combine these
+ plus_mod_dep (m1, orphan1, boot1) (m2, orphan2, boot2)
+ = ASSERT( m1 == m2 && orphan1 == orphan2 )
+ (m1, orphan1, boot1 && boot2)
+ -- If either side can "see" a non-hi-boot interface, use that
\end{code}
%************************************************************************
addAvail :: AvailEnv -> AvailInfo -> AvailEnv
addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
+
+mkAvailEnv :: [AvailInfo] -> AvailEnv
+ -- 'avails' may have several items with the same availName
+ -- E.g import Ix( Ix(..), index )
+ -- will give Ix(Ix,index,range) and Ix(index)
+ -- We want to combine these; addAvail does that
+mkAvailEnv avails = foldl addAvail emptyAvailEnv avails
\end{code}
%************************************************************************
| ImportForUsage IsBootInterface -- Import when chasing usage info from an interaface file
-- Failure in this case is not an error
- | ImportBySystem -- Non user import. Use eps_mod_info to decide whether
- -- the module this module depends on, or is a system-ish module;
- -- M.hi-boot otherwise
+ | ImportBySystem -- Non user import.
instance Outputable WhereFrom where
ppr (ImportByUser is_boot) | is_boot = ptext SLIT("{- SOURCE -}")
projects / ghc-hetmet.git / commitdiff