Commit e0445ffa authored by simonpj's avatar simonpj
Browse files

[project @ 2002-10-24 14:17:46 by simonpj]

------------------------------------------
	1. New try and module and package dependencies
	2. OrigNameCache always contains final info
	------------------------------------------

These things nearly complete sorting out the incremental
linking problem that started us off!

1. This commit separates two kinds of information:

  (a) HscTypes.Dependencies:
	What (i)  home-package modules, and
	     (ii) other packages
      this module depends on, transitively.

      That is, to link the module, it should be enough
      to link the dependent modules and packages (plus
      any C stubs etc).

      Along with this info we record whether the dependent module
      is (a) a boot interface or (b) an orphan module.  So in
      fact (i) can contain non-home-package modules, namely the
      orphan ones in other packages (sigh).

  (b) HscTypes.Usage:
      What version of imported things were used to
      actually compile the module.  This info is used for
      recompilation control only.



2. The Finder now returns a correct Module (incl package indicator)
first time, so we can install the absolutely final Name in the
OrigNameCache when we first come across an occurrence of that name,
even if it's only an occurrence in an unfolding in some other interface
file.  This is much tidier.

As a result Module.lhs is much cleaner
	No DunnoYet
	No mkVanillaModule
ALl very joyful stuff.
parent 04a63774
......@@ -56,9 +56,8 @@ module Module
, 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
......@@ -84,7 +83,7 @@ module 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(..) )
......@@ -118,24 +117,13 @@ renamer href here.)
\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
......@@ -274,13 +262,21 @@ pprModule (Module mod p) = getPprStyle $ \ sty ->
\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
......@@ -292,16 +288,6 @@ isHomeModule _ = False
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
......
......@@ -34,7 +34,7 @@ module Name (
#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 )
......@@ -177,11 +177,11 @@ mkInternalName uniq occ loc = Name { n_uniq = uniq, n_sort = Internal, n_occ = o
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
......
......@@ -15,7 +15,7 @@ import HscTypes ( ModGuts(..), ModGuts, HscEnv(..), ExternalPackageState(..),
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
......@@ -89,9 +89,11 @@ deSugar hsc_env pcs
(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,
......
......@@ -42,10 +42,16 @@ import HsSyn ( Pat(..), HsExpr(..), Stmt(..), HsLit(..), HsOverLit(..),
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
......@@ -963,90 +969,99 @@ templateHaskellNames
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
......
......@@ -18,7 +18,7 @@ module HsDecls (
tyClDeclName, tyClDeclNames, tyClDeclTyVars,
isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl,
isTypeOrClassDecl, countTyClDecls,
isSourceInstDecl, ifaceRuleDeclName,
isSourceInstDecl, instDeclDFun, ifaceRuleDeclName,
conDetailsTys,
collectRuleBndrSigTys, isSrcRule
) where
......@@ -649,6 +649,9 @@ data InstDecl name
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}
......
......@@ -31,7 +31,7 @@ import Name ( nameModule, nameOccName, isExternalName, isInternalName, NamedThi
import Subst ( substTyWith )
import Module ( Module, PackageName, ModuleName, moduleName,
modulePackage, preludePackage,
modulePackage, basePackage,
isHomeModule, isVanillaModule,
pprModuleName, mkHomeModule, mkModuleName
)
......@@ -168,7 +168,7 @@ importsName env n
importsPrelude | inPrelude = addModuleImpInfo (mkModuleName "PrelGHC")
| otherwise = addPackageImpInfo preludePackage
| otherwise = addPackageImpInfo basePackage
importsType :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo
......@@ -1465,7 +1465,7 @@ nameReference env n
-- 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))
......@@ -1477,13 +1477,13 @@ moduleReference env m
| 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,
......@@ -1693,13 +1693,13 @@ prelGHCReference :: IlxTyFrag
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# */ "
......
......@@ -269,12 +269,13 @@ instance Binary ModIface where
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))
......@@ -309,14 +310,9 @@ deprecsToIfaceDeprecs (DeprecSome env) = Just (Right (nameEnvElts env))
{-! 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)
......@@ -370,6 +366,7 @@ instance Binary ParsedIface where
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
......@@ -382,6 +379,7 @@ instance Binary ParsedIface where
pi_pkg = pkg_name,
pi_vers = module_ver,
pi_orphan = orphan,
pi_deps = deps,
pi_usages = usages,
pi_exports = exports,
pi_decls = tycl_decls,
......@@ -412,29 +410,23 @@ instance (Binary name) => Binary (GenAvailInfo name) where
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
......
......@@ -1176,7 +1176,7 @@ staticLink o_files = 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 []
......@@ -1252,7 +1252,7 @@ doMkDLL o_files = do
-- 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
--
......@@ -18,7 +18,7 @@ import Packages ( PackageConfig(..), PackageConfigMap,
PackageName, mkPackageName, packageNameString,
packageDependents,
mungePackagePaths, emptyPkgMap, extendPkgMap, lookupPkg,
preludePackage, rtsPackage, haskell98Package )
basePackage, rtsPackage, haskell98Package )
import CmdLineOpts
import DriverPhases
import DriverUtil
......@@ -489,7 +489,7 @@ getPackages :: IO [PackageName]
getPackages = readIORef v_Packages
initPackageList = [haskell98Package,
preludePackage,
basePackage,
rtsPackage]
addPackage :: String -> IO ()
......
......@@ -40,6 +40,7 @@ import Parser
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 )
......@@ -57,7 +58,7 @@ import SimplStg ( stg2stg )
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 )
......@@ -692,7 +693,6 @@ initExternalPackageState
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,
......@@ -708,11 +708,11 @@ initExternalPackageState
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}
......@@ -32,8 +32,7 @@ module HscTypes (
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,
......@@ -83,14 +82,15 @@ import Class ( Class, classSelIds )
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 )