%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-2002
%
-\section[Module]{The @Module@ module.}
-Representing modules and their flavours.
+ModuleName
+~~~~~~~~~~
+Simply the name of a module, represented as a Z-encoded FastString.
+These are Uniquable, hence we can build FiniteMaps with ModuleNames as
+the keys.
+Module
+~~~~~~
+
+A ModuleName with some additional information, namely whether the
+module resides in the Home package or in a different package. We need
+to know this for two reasons:
+
+ * generating cross-DLL calls is different from intra-DLL calls
+ (see below).
+ * we don't record version information in interface files for entities
+ in a different package.
+
+The unique of a Module is identical to the unique of a ModuleName, so
+it is safe to look up in a Module map using a ModuleName and vice
+versa.
Notes on DLLs
~~~~~~~~~~~~~
Module, -- Abstract, instance of Eq, Ord, Outputable
, PackageName -- = FastString; instance of Outputable, Uniquable
- , modulePackage -- :: Module -> PackageName
- , preludePackage -- :: PackageName name of Standard Prelude package
+ , preludePackage -- :: PackageName
, ModuleName
, pprModuleName -- :: ModuleName -> SDoc
, mkVanillaModule -- :: ModuleName -> Module
, isVanillaModule -- :: Module -> Bool
, mkPrelModule -- :: UserString -> Module
- , isPrelModule -- :: Module -> Bool
, mkModule -- :: ModuleName -> PackageName -> Module
, mkHomeModule -- :: ModuleName -> Module
, isHomeModule -- :: Module -> Bool
+ , mkPackageModule -- :: ModuleName -> Module
, mkModuleName -- :: UserString -> ModuleName
, mkModuleNameFS -- :: UserFS -> ModuleName
renamer href here.)
\begin{code}
-data Module = Module ModuleName PackageInfo
+data Module = Module ModuleName !PackageInfo
data PackageInfo
= ThisPackage -- A module from the same package
-- as the one being compiled
- | AnotherPackage PackageName -- A module from a different package
+ | 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
packageInfoPackage :: PackageInfo -> PackageName
packageInfoPackage ThisPackage = opt_InPackage
packageInfoPackage DunnoYet = SLIT("<?>")
-packageInfoPackage (AnotherPackage p) = p
+packageInfoPackage AnotherPackage = SLIT("<pkg>")
instance Outputable PackageInfo where
-- Just used in debug prints of lex tokens and in debug modde
= Module mod_nm pack_info
where
pack_info | pack_name == opt_InPackage = ThisPackage
- | otherwise = AnotherPackage pack_name
+ | otherwise = AnotherPackage
mkHomeModule :: ModuleName -> Module
mkHomeModule mod_nm = Module mod_nm ThisPackage
isHomeModule (Module nm ThisPackage) = True
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.)
mkPrelModule :: ModuleName -> Module
mkPrelModule name = mkModule name preludePackage
-isPrelModule :: Module -> Bool
-isPrelModule (Module nm (AnotherPackage p)) | p == preludePackage = True
-isPrelModule _ = False
-
moduleString :: Module -> EncodedString
moduleString (Module (ModuleName fs) _) = _UNPK_ fs
moduleName :: Module -> ModuleName
moduleName (Module mod pkg_info) = mod
-modulePackage :: Module -> PackageName
-modulePackage (Module mod pkg_info) = packageInfoPackage pkg_info
-
moduleUserString :: Module -> UserString
moduleUserString (Module mod _) = moduleNameUserString mod
\end{code}
The Finder provides a thin filesystem abstraction to the rest of the
-compiler. For a given module, it knows (a) which package the module
-lives in, so it can make a Module from a ModuleName, and (b) where the
-source, interface, and object files for a module live.
+compiler. For a given module, it knows (a) whether the module lives
+in the home package or in another package, so it can make a Module
+from a ModuleName, and (b) where the source, interface, and object
+files for a module live.
+
+It does *not* know which particular package a module lives in, because
+that information is only contained in the interface file.
\begin{code}
initFinder :: [PackageConfig] -> IO ()
-- When generating dependencies, we're interested in either category.
--
source_exts =
- [ ("hs", \ _ fName path -> mkHomeModuleLocn mod_name path fName)
- , ("lhs", \ _ fName path -> mkHomeModuleLocn mod_name path fName)
- ]
- hi_exts = [ (hisuf, \ _ fName path -> mkHiOnlyModuleLocn mod_name fName) ]
+ [ ("hs", \ fName path -> mkHomeModuleLocn mod_name path fName)
+ , ("lhs", \ fName path -> mkHomeModuleLocn mod_name path fName)
+ ]
+ hi_exts = [ (hisuf, \ fName path -> mkHiOnlyModuleLocn mod_name fName) ]
std_exts
| mode == DoMkDependHS = hi_exts ++ source_exts
hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion
boot_exts =
- [ (hi_boot_ver, \ _ fName path -> mkHiOnlyModuleLocn mod_name fName)
- , ("hi-boot", \ _ fName path -> mkHiOnlyModuleLocn mod_name fName)
+ [ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName)
+ , ("hi-boot", \ fName path -> mkHiOnlyModuleLocn mod_name fName)
]
- searchPathExts
- (map ((,) undefined) home_path)
- basename
+ searchPathExts home_path basename
(if is_source then (boot_exts++std_exts) else std_exts ++ boot_exts)
-- for SOURCE imports, check the hi-boot extensions
-- before the source/iface ones, to avoid
if null tag
then return "hi"
else return (tag ++ "_hi")
- let imp_dirs = concatMap (\ pkg -> map ((,) pkg) (import_dirs pkg)) pkgs
+ let imp_dirs = concatMap import_dirs pkgs
mod_str = moduleNameUserString mod_name
basename = map (\c -> if c == '.' then '/' else c) mod_str
- mkPackageModule mod_name pkg mbFName path =
- return ( mkModule mod_name (mkFastString (name pkg))
+ retPackageModule mod_name mbFName path =
+ return ( mkPackageModule mod_name
, ModuleLocation{ ml_hspp_file = Nothing
, ml_hs_file = mbFName
, ml_hi_file = path ++ '.':package_hisuf
searchPathExts
imp_dirs basename
- ((package_hisuf,\ pkg fName path -> mkPackageModule mod_name pkg Nothing path) :
+ ((package_hisuf,\ fName path -> retPackageModule mod_name Nothing path) :
-- can packages contain hi-boots?
(if hiOnly then [] else
- [ ("hs", \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
- , ("lhs", \ pkg fName path -> mkPackageModule mod_name pkg (Just fName) path)
+ [ ("hs", \ fName path -> retPackageModule mod_name (Just fName) path)
+ , ("lhs", \ fName path -> retPackageModule mod_name (Just fName) path)
]))
where
findPackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
findPackageModule mod_name = findPackageMod mod_name True
-searchPathExts :: [(a, FilePath)]
+searchPathExts :: [FilePath]
-> String
- -> [(String, a -> FilePath -> String -> IO (Module, ModuleLocation))]
+ -> [(String, FilePath -> String -> IO (Module, ModuleLocation))]
-> IO (Maybe (Module, ModuleLocation))
searchPathExts path basename exts = search exts
where
found <- findOnPath path fName
case found of
-- special case to avoid getting "./foo.<ext>" all the time
- Just (v,".") -> fmap Just (f v fName basename)
- Just (v,path) -> fmap Just (f v (path ++ '/':fName)
+ Just "." -> fmap Just (f fName basename)
+ Just path -> fmap Just (f (path ++ '/':fName)
(path ++ '/':basename))
Nothing -> search xs
-findOnPath :: [(a,String)] -> String -> IO (Maybe (a, FilePath))
+findOnPath :: [String] -> String -> IO (Maybe FilePath)
findOnPath path s = loop path
where
loop [] = return Nothing
- loop ((a,d):ds) = do
+ loop (d:ds) = do
let file = d ++ '/':s
b <- doesFileExist file
- if b then return (Just (a,d)) else loop ds
+ if b then return (Just d) else loop ds
\end{code}
(pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
<- _scc_ "checkOldIface"
- checkOldIface ghci_mode dflags hit hst pcs (ml_hi_file location)
+ checkOldIface ghci_mode dflags hit hst pcs mod (ml_hi_file location)
source_unchanged maybe_old_iface;
if errs_found then
import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
import NameEnv
import OccName ( OccName )
-import Module ( Module, ModuleName, ModuleEnv,
- lookupModuleEnv, lookupModuleEnvByName,
- emptyModuleEnv, moduleUserString
- )
+import Module
import InstEnv ( InstEnv, ClsInstEnv, DFunId )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
\begin{code}
data ModIface
= ModIface {
- mi_module :: !Module, -- Complete with package info
+ mi_module :: !Module,
+ mi_package :: !PackageName, -- Which package the module comes from
mi_version :: !VersionInfo, -- Module version number
mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
emptyModIface :: Module -> ModIface
emptyModIface mod
= ModIface { mi_module = mod,
+ mi_package = preludePackage, -- XXX fully bogus
mi_version = initialVersionInfo,
mi_usages = [],
mi_orphan = False,
pprIface :: ModIface -> SDoc
pprIface iface
= vcat [ ptext SLIT("__interface")
- <+> doubleQuotes (ptext opt_InPackage)
+ <+> doubleQuotes (ptext (mi_package iface))
<+> ppr (mi_module iface) <+> ppr (vers_module version_info)
<+> pp_sub_vers
<+> (if mi_orphan iface then char '!' else empty)
rules_and_deprecs_part
{ let (rules,deprecs) = $14 () in
ParsedIface {
- pi_mod = mkModule $3 $2, -- Module itself
+ pi_mod = $3, -- Module name
+ pi_pkg = $2, -- Package name
pi_vers = $4, -- Module version
pi_orphan = $6,
pi_exports = (fst $5, $9), -- Exports
instDeclFVs, tyClDeclFVs, ruleDeclFVs
)
-import CmdLineOpts ( DynFlags, DynFlag(..) )
+import CmdLineOpts ( DynFlags, DynFlag(..), opt_InPackage )
import RnMonad
import RnExpr ( rnStmt )
import RnNames ( getGlobalNames, exportsFromAvail )
final_decls = rn_local_decls ++ rn_imp_decls
mod_iface = ModIface { mi_module = this_module,
+ mi_package = opt_InPackage,
mi_version = initialVersionInfo,
mi_usages = my_usages,
mi_boot = False,
-> DynFlags
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
+ -> Module
-> FilePath
-> Bool -- Source unchanged
-> Maybe ModIface -- Old interface from compilation manager, if any
-> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
-- True <=> errors happened
-checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
+checkOldIface ghci_mode dflags hit hst pcs mod iface_path source_unchanged maybe_iface
= runRn dflags hit hst pcs (panic "Bogus module") $
-- CHECK WHETHER THE SOURCE HAS CHANGED
returnRn (outOfDate, maybe_iface)
else
+ setModuleRn mod $
case maybe_iface of
Just old_iface -> -- Use the one we already have
- setModuleRn (mi_module old_iface) (check_versions old_iface)
+ check_versions old_iface
Nothing -- try and read it from a file
-> readIface iface_path `thenRn` \ read_result ->
$$ nest 4 err) `thenRn_`
returnRn (outOfDate, Nothing)
- Right parsed_iface
- -> setModuleRn (pi_mod parsed_iface) $
- loadOldIface parsed_iface `thenRn` \ m_iface ->
+ Right parsed_iface ->
+ let read_mod_name = pi_mod parsed_iface
+ wanted_mod_name = moduleName mod
+ in
+ if (wanted_mod_name /= read_mod_name) then
+ traceHiDiffsRn (
+ text "Existing interface file has wrong module name: "
+ <> quotes (ppr read_mod_name)
+ ) `thenRn_`
+ returnRn (outOfDate, Nothing)
+ else
+ loadOldIface mod parsed_iface `thenRn` \ m_iface ->
check_versions m_iface
where
check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
but what?
\begin{code}
-loadOldIface :: ParsedIface -> RnMG ModIface
+loadOldIface :: Module -> ParsedIface -> RnMG ModIface
-loadOldIface parsed_iface
+loadOldIface mod parsed_iface
= let iface = parsed_iface
- mod = pi_mod iface
in
initIfaceRnMS mod (
loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
decls = mkIfaceDecls new_decls new_rules new_insts
- mod_iface = ModIface { mi_module = mod, mi_version = version,
+ mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg parsed_iface,
+ mi_version = version,
mi_exports = avails, mi_usages = usages,
mi_boot = False, mi_orphan = pi_orphan iface,
mi_fixities = fix_env, mi_deprecs = deprec_env,
-- Now add info about this module to the PIT
has_orphans = pi_orphan iface
new_pit = extendModuleEnv pit mod mod_iface
- mod_iface = ModIface { mi_module = mod, mi_version = version,
+ mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface,
+ mi_version = version,
mi_orphan = has_orphans, mi_boot = hi_boot_file,
mi_exports = avails,
mi_fixities = fix_env, mi_deprecs = deprec_env,
readIface file `thenRn` \ read_result ->
case read_result of
Left bad -> returnRn (Left bad)
- Right iface
- -> let read_mod = pi_mod iface
- in -- check that the module names agree
- checkRn
- (wanted_mod == read_mod)
- (hiModuleNameMismatchWarn wanted_mod read_mod)
+ Right iface -> -- check that the module names agree
+ let read_mod_name = pi_mod iface
+ wanted_mod_name = moduleName wanted_mod
+ in
+ checkRn
+ (wanted_mod_name == read_mod_name)
+ (hiModuleNameMismatchWarn wanted_mod_name read_mod_name)
`thenRn_`
- -- check that the package names agree
- warnCheckRn
- (modulePackage wanted_mod == modulePackage read_mod)
- (packageNameMismatchWarn wanted_mod read_mod)
- `thenRn_`
returnRn (Right (wanted_mod, iface))
-- Can't find it
other -> traceRn (ptext SLIT("...not found")) `thenRn_`
= vcat [ptext SLIT("Bad interface file:") <+> text file,
nest 4 err]
-hiModuleNameMismatchWarn :: Module -> Module -> Message
+hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
hiModuleNameMismatchWarn requested_mod read_mod =
hsep [ ptext SLIT("Something is amiss; requested module name")
- , ppr (moduleName requested_mod)
+ , ppr requested_mod
, ptext SLIT("differs from name found in the interface file")
, ppr read_mod
]
-packageNameMismatchWarn :: Module -> Module -> Message
-packageNameMismatchWarn requested_mod read_mod =
- fsep [ ptext SLIT("Module"), quotes (ppr requested_mod),
- ptext SLIT("is located in package"),
- quotes (ptext (modulePackage requested_mod)),
- ptext SLIT("but its interface file claims it is part of package"),
- quotes (ptext (modulePackage read_mod))
- ]
-
warnRedundantSourceImport mod_name
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
<+> quotes (ppr mod_name)
decode, mkLocalName, mkKnownKeyGlobal
)
import NameEnv ( NameEnv, lookupNameEnv, emptyNameEnv, extendNameEnvList )
-import Module ( Module, ModuleName, ModuleSet, emptyModuleSet )
+import Module ( Module, ModuleName, ModuleSet, emptyModuleSet, PackageName )
import NameSet
import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
import SrcLoc ( SrcLoc, generatedSrcLoc, noSrcLoc )
data ParsedIface
= ParsedIface {
- pi_mod :: Module, -- Complete with package info
+ pi_mod :: ModuleName,
+ pi_pkg :: PackageName,
pi_vers :: Version, -- Module version number
pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
pi_usages :: [ImportVersion OccName], -- Usages
projects / ghc-hetmet.git / commitdiff