import HscMain ( hscThing, hscStmt, hscTcExpr )
import Module ( moduleUserString )
import TcRnDriver ( mkGlobalContext, getModuleContents )
-import Name ( Name, NamedThing(..), isExternalName )
+import Name ( Name, NamedThing(..), isExternalName, nameModule )
import Id ( idType )
import Type ( tidyType )
import VarEnv ( emptyTidyEnv )
import BasicTypes ( Fixity, FixitySig(..), defaultFixity )
-import Linker ( HValue, unload, extendLinkEnv )
+import Linker ( HValue, unload, extendLinkEnv, findLinkable )
import GHC.Exts ( unsafeCoerce# )
import Foreign
import Control.Exception as Exception ( Exception, try )
getFixity :: PersistentCompilerState -> Name -> Fixity
getFixity pcs name
| isExternalName name,
- Just iface <- lookupIface hpt pit name,
+ Just iface <- lookupIface hpt pit (nameModule name),
Just (FixitySig _ fixity _) <- lookupNameEnv (mi_fixities iface) name
= fixity
| otherwise
<- if (not objects_allowed)
then return Nothing
- else case ml_obj_file (ms_location summary) of
- Just obj_fn -> maybe_getFileLinkable mod_name obj_fn
- Nothing -> return Nothing
+ else findLinkable mod_name (ms_location summary)
let old_linkable = findModuleLinkable_maybe old_linkables mod_name
return (new_linkables' ++ new_linkables)
-maybe_getFileLinkable :: ModuleName -> FilePath -> IO (Maybe Linkable)
-maybe_getFileLinkable mod obj_fn
- = do obj_exist <- doesFileExist obj_fn
- if not obj_exist
- then return Nothing
- else
- do let stub_fn = case splitFilename3 obj_fn of
- (dir, base, ext) -> dir ++ "/" ++ base ++ ".stub_o"
- stub_exist <- doesFileExist stub_fn
- obj_time <- getModificationTime obj_fn
- if stub_exist
- then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
- else return (Just (LM obj_time mod [DotO obj_fn]))
-
hptLinkables :: HomePackageTable -> [Linkable]
-- Get all the linkables from the home package table, one for each module
-- Once the HPT is up to date, these are the ones we should link
import CmdLineOpts ( DynFlag(..), dopt, opt_SccProfilingOn )
import HscTypes ( ModGuts(..), ModGuts, HscEnv(..), ExternalPackageState(..),
- PersistentCompilerState(..),
+ PersistentCompilerState(..), Dependencies(..),
lookupType, unQualInScope )
import HsSyn ( MonoBinds, RuleDecl(..), RuleBndr(..),
HsExpr(..), HsBinds(..), MonoBinds(..) )
(printDump (ppr_ds_rules ds_rules))
; let
- deps = (moduleEnvElts (dep_mods imports), dep_pkgs imports)
+ deps = Deps { dep_mods = moduleEnvElts (imp_dep_mods imports),
+ dep_pkgs = imp_dep_pkgs imports,
+ dep_orphs = imp_orphs imports }
mod_guts = ModGuts {
mg_module = mod,
mg_exports = exports,
-- ws previously used in this file.
import qualified OccName( varName, tcName )
-import Module ( moduleUserString )
+import Module ( Module, mkThPkgModule, moduleUserString )
import Id ( Id, idType )
+import Name ( mkKnownKeyExternalName )
+import OccName ( mkOccFS )
import NameEnv
import NameSet
import Type ( Type, TyThing(..), mkGenTyConApp )
-- NB: the THSyntax module comes from the "haskell-src" package
thModule = mkThPkgModule mETA_META_Name
-mk_known_key_name space mod str uniq
+mk_known_key_name space str uniq
= mkKnownKeyExternalName thModule (mkOccFS space str) uniq
intLName = varQual FSLIT("intL") intLIdKey
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
module Linker ( HValue, initLinker, showLinkerState,
- linkPackages, linkLibraries,
+ linkPackages, linkLibraries, findLinkable,
linkModules, unload, extendLinkEnv, linkExpr,
LibrarySpec(..)
) where
import Packages ( PackageConfig(..), PackageName, PackageConfigMap, lookupPkg,
packageDependents, packageNameString )
import DriverState ( v_Library_paths, v_Cmdline_libraries, getPackageConfigMap )
-
+import DriverUtil ( splitFilename3 )
+import Finder ( findModule )
import HscTypes ( Linkable(..), isObjectLinkable, nameOfObject, byteCodeOfObject,
- Unlinked(..), isInterpretable, isObject,
+ Unlinked(..), isInterpretable, isObject, Dependencies(..),
HscEnv(..), PersistentCompilerState(..), ExternalPackageState(..),
- HomePackageTable, PackageIfaceTable, ModIface(..), HomeModInfo(..) )
+ HomePackageTable, PackageIfaceTable, ModIface(..), HomeModInfo(..),
+ lookupIface )
import Name ( Name, nameModule, isExternalName )
import NameEnv
import NameSet ( nameSetToList )
-import Module ( Module, ModuleName, moduleName, lookupModuleEnvByName )
+import Module ( ModLocation(..), Module, ModuleName, moduleName, lookupModuleEnvByName )
import FastString ( FastString(..), unpackFS )
+import ListSetOps ( minusList )
import CmdLineOpts ( DynFlags(verbosity) )
import BasicTypes ( SuccessFlag(..), succeeded, failed )
import Outputable
import Control.Monad ( when, filterM, foldM )
import Data.IORef ( IORef, readIORef, writeIORef )
-import Data.List ( partition )
+import Data.List ( partition, nub )
import System.IO ( putStr, putStrLn, hPutStrLn, stderr, fixIO )
-import System.Directory ( doesFileExist )
+import System.Directory ( doesFileExist, getModificationTime )
import Control.Exception ( block, throwDyn )
-- dependents to link.
linkExpr hsc_env pcs (root_ul_bco, aux_ul_bcos)
- = -- Find what packages and linkables are required
- case getLinkDeps hpt pit needed_mods of {
- Left msg -> dieWith (msg $$ ptext SLIT("When linking an expression")) ;
- Right (lnks, pkgs) -> do {
+ = do {
+ -- Find what packages and linkables are required
+ (lnks, pkgs) <- getLinkDeps hpt pit needed_mods ;
+ -- Link the packages and modules required
linkPackages dflags pkgs
; ok <- linkModules dflags lnks
; if failed ok then
-- Link the necessary packages and linkables
; (_, (root_hval:_)) <- linkSomeBCOs False ie ce all_bcos
; return root_hval
- }}}
+ }}
where
pit = eps_PIT (pcs_EPS pcs)
hpt = hsc_HPT hsc_env
dieWith msg = throwDyn (UsageError (showSDoc msg))
getLinkDeps :: HomePackageTable -> PackageIfaceTable
- -> [Module] -- If you need these
- -> Either Message
- ([Linkable], [PackageName]) -- ... then link these first
+ -> [Module] -- If you need these
+ -> IO ([Linkable], [PackageName]) -- ... then link these first
+-- Fails with an IO exception if it can't find enough files
+getLinkDeps hpt pit mods
-- Find all the packages and linkables that a set of modules depends on
+ = do { pls <- readIORef v_PersistentLinkerState ;
+ let {
+ -- 1. Find the iface for each module (must exist),
+ -- and extract its dependencies
+ deps = [ mi_deps (get_iface mod) | mod <- mods ] ;
+
+ -- 2. Find the dependent home-pkg-modules/packages from each iface
+ -- Include mods themselves; and exclude ones already linked
+ mods_needed = nub (map moduleName mods ++ [m | dep <- deps, (m,_) <- dep_mods dep])
+ `minusList`
+ linked_mods ;
+ linked_mods = map linkableModName (objs_loaded pls ++ bcos_loaded pls) ;
+
+ pkgs_needed = nub (concatMap dep_pkgs deps)
+ `minusList`
+ pkgs_loaded pls } ;
+
+ -- 3. For each dependent module, find its linkable
+ -- This will either be in the HPT or (in the case of one-shot compilation)
+ -- we may need to use maybe_getFileLinkable
+ lnks_needed <- mapM get_linkable mods_needed ;
-getLinkDeps hpt pit mods
- = go [] -- Linkables so far
- [] -- Packages so far
- [] -- Modules dealt with
- (map moduleName mods) -- The usage info that we use for
- -- dependencies has ModuleNames not Modules
+ return (lnks_needed, pkgs_needed) }
where
- go lnks pkgs _ [] = Right (lnks,pkgs)
- go lnks pkgs mods_done (mod:mods)
- | mod `elem` mods_done
- = -- Already dealt with
- go lnks pkgs mods_done mods
-
- | Just mod_info <- lookupModuleEnvByName hpt mod
- = -- OK, so it's a home module
- let
- mod_deps = [m | (m,_,_,_) <- mi_usages (hm_iface mod_info)]
- -- Get the modules that this one depends on
- in
- go (hm_linkable mod_info : lnks) pkgs (mod : mods_done) (mod_deps ++ mods)
-
- | Just pkg_iface <- lookupModuleEnvByName pit mod
- = -- It's a package module, so add it to the package list
- let
- pkg_name = mi_package pkg_iface
- pkgs' | pkg_name `elem` pkgs = pkgs
- | otherwise = pkg_name : pkgs
- in
- go lnks pkgs' (mod : mods_done) mods
-
- | otherwise
- = -- Not in either table
- Left (ptext SLIT("Can't find compiled code for dependent module") <+> ppr mod)
+ get_iface mod = case lookupIface hpt pit mod of
+ Just iface -> iface
+ Nothing -> pprPanic "getLinkDeps" (no_iface mod)
+ no_iface mod = ptext SLIT("No iface for") <+> ppr mod
+ -- This one is a GHC bug
+
+ no_obj mod = dieWith (ptext SLIT("No compiled code for for") <+> ppr mod)
+ -- This one is a build-system bug
+
+ get_linkable mod_name -- A home-package module
+ | Just mod_info <- lookupModuleEnvByName hpt mod_name
+ = return (hm_linkable mod_info)
+ | otherwise
+ = -- It's not in the HPT because we are in one shot mode,
+ -- so use the Finder to get a ModLocation...
+ do { mb_stuff <- findModule mod_name ;
+ case mb_stuff of {
+ Nothing -> no_obj mod_name ;
+ Just (_, loc) -> do {
+
+ -- ...and then find the linkable for it
+ mb_lnk <- findLinkable mod_name loc ;
+ case mb_lnk of {
+ Nothing -> no_obj mod_name ;
+ Just lnk -> return lnk
+ }}}}
\end{code}
return (Just file_path)
else
findFile mk_file_path dirs }
+
+
+findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable)
+findLinkable mod locn
+ | Just obj_fn <- ml_obj_file locn
+ = do obj_exist <- doesFileExist obj_fn
+ if not obj_exist
+ then return Nothing
+ else
+ do let stub_fn = case splitFilename3 obj_fn of
+ (dir, base, ext) -> dir ++ "/" ++ base ++ ".stub_o"
+ stub_exist <- doesFileExist stub_fn
+ obj_time <- getModificationTime obj_fn
+ if stub_exist
+ then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
+ else return (Just (LM obj_time mod [DotO obj_fn]))
+ | otherwise
+ = return Nothing
\end{code}
\begin{code}
-- Imported from other files :-
+instance Binary Dependencies where
+ put_ bh deps = do put_ bh (dep_mods deps)
+ put_ bh (dep_pkgs deps)
+ put_ bh (dep_orphs deps)
+
+ get bh = do ms <- get bh
+ ps <- get bh
+ os <- get bh
+ return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os })
+
instance (Binary name) => Binary (GenAvailInfo name) where
put_ bh (Avail aa) = do
putByte bh 0
extendTypeEnvList, extendTypeEnvWithIds,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
- WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..), Dependencies,
+ WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..),
+ Dependencies(..), noDependencies,
IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn,
NameCache(..), OrigNameCache, OrigIParamCache,
Avails, availsToNameSet, availName, availNames,
Simple lookups in the symbol table.
\begin{code}
-lookupIface :: HomePackageTable -> PackageIfaceTable -> Name -> Maybe ModIface
+lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
-lookupIface hpt pit name
+lookupIface hpt pit mod
= case lookupModuleEnv hpt mod of
Just mod_info -> Just (hm_iface mod_info)
Nothing -> lookupModuleEnv pit mod
- where
- mod = nameModule name
lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
mi_package = basePackage, -- XXX fully bogus
mi_version = initialVersionInfo,
mi_usages = [],
- mi_deps = ([], []),
+ mi_deps = noDependencies,
mi_orphan = False,
mi_boot = False,
mi_exports = [],
-- in the import hierarchy. See TcRnTypes.ImportAvails for details.
--
-- Invariant: the dependencies of a module M never includes M
-type Dependencies
- = ([(ModuleName, WhetherHasOrphans, IsBootInterface)], [PackageName])
-
+data Dependencies
+ = Deps { dep_mods :: [(ModuleName,IsBootInterface)], -- Home-package module dependencies
+ dep_pkgs :: [PackageName], -- External package dependencies
+ dep_orphs :: [ModuleName] } -- Orphan modules (whether home or external pkg)
+
+noDependencies :: Dependencies
+noDependencies = Deps [] [] []
+
data Usage name
= Usage { usg_name :: ModuleName, -- Name of the module
usg_mod :: Version, -- Module version
import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl )
import HscTypes ( VersionInfo(..), ModIface(..), HomeModInfo(..),
ModGuts(..), ModGuts,
- GhciMode(..), HscEnv(..),
+ GhciMode(..), HscEnv(..), Dependencies(..),
FixityEnv, lookupFixity, collectFixities,
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
- TyThing(..), DFunId, Dependencies,
+ TyThing(..), DFunId,
Avails, AvailInfo, GenAvailInfo(..), availName,
ExternalPackageState(..),
ParsedIface(..), Usage(..),
mkUsageInfo hsc_env eps
(ImportAvails { imp_mods = dir_imp_mods,
- dep_mods = dep_mods })
+ imp_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
usages `seqList` usages
where
usages = catMaybes [ mkUsage mod_name
- | (mod_name,_,_) <- moduleEnvElts dep_mods]
+ | (mod_name,_) <- moduleEnvElts dep_mods]
hpt = hsc_HPT hsc_env
pit = eps_PIT eps
pprDeps :: Dependencies -> SDoc
-pprDeps (mods, pkgs)
+pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs})
= vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
- ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs)]
+ ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs),
+ ptext SLIT("orphans:") <+> fsep (map ppr orphs)
+ ]
where
- ppr_mod (mod_name, orph, boot)
- = ppr mod_name <+> ppr_orphan orph <+> ppr_boot boot
+ ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
- ppr_orphan True = char '!'
- ppr_orphan False = empty
- ppr_boot True = char '@'
+ ppr_boot True = text "[boot]"
ppr_boot False = empty
\end{code}
{- -*-haskell-*-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.112 2002/10/24 14:17:50 simonpj Exp $
+$Id: Parser.y,v 1.113 2002/10/25 15:23:06 simonpj Exp $
Haskell grammar.
import HsTypes ( mkHsTupCon )
import RdrHsSyn
-import HscTypes ( ParsedIface(..), IsBootInterface )
+import HscTypes ( ParsedIface(..), IsBootInterface, noDependencies )
import Lex
import RdrName
import PrelNames ( mAIN_Name, funTyConName, listTyConName,
pi_vers = 1, -- Module version
pi_orphan = False,
pi_exports = (1,[($2,mkIfaceExports $4)]),
- pi_deps = ([],[]),
+ pi_deps = noDependencies,
pi_usages = [],
pi_fixity = [],
pi_insts = [],
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import Parser ( parseIface )
import HscTypes ( ModIface(..), emptyModIface,
- ExternalPackageState(..),
+ ExternalPackageState(..), noDependencies,
VersionInfo(..), Usage(..),
lookupIfaceByModName, RdrExportItem,
- WhetherHasOrphans, IsBootInterface,
+ IsBootInterface,
DeclsMap, GatedDecl, IfaceInsts, IfaceRules, mkIfaceDecls,
AvailInfo, GenAvailInfo(..), ParsedIface(..), IfaceDeprecs,
Avails, availNames, availName, Deprecations(..)
-- before we got to real imports.
other ->
- traceRn (vcat [text "loadInterface" <+> brackets doc_str,
- ppr (dep_mods import_avails)]) `thenM_`
let
- mod_map = dep_mods import_avails
+ mod_map = imp_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
ghcPrimIface = ParsedIface {
pi_mod = gHC_PRIM_Name,
pi_pkg = basePackage,
- pi_deps = ([],[]),
+ pi_deps = noDependencies,
pi_vers = 1,
pi_orphan = False,
pi_usages = [],
old_gates = eps_inst_gates eps
new_gates = gates `minusNameSet` old_gates
all_gates = new_gates `unionNameSets` old_gates
- orphan_mods = [mod | (mod, True, _) <- moduleEnvElts (dep_mods imports)]
+ orphan_mods = imp_orphs imports
in
loadOrphanModules orphan_mods `thenM_`
-- Source code unchanged and no errors yet... carry on
-- First put the dependent-module info in the envt, just temporarily,
- -- so that when we look for interfaces we look for the right one.
+ -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
-- 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).
where
-- This is a bit of a hack really
- mod_deps = emptyImportAvails { dep_mods = mkModDeps (fst (mi_deps iface)) }
+ mod_deps = emptyImportAvails { imp_dep_mods = mkModDeps (dep_mods (mi_deps iface)) }
checkList :: [TcRn m RecompileRequired] -> TcRn m RecompileRequired
checkList [] = returnM upToDate
import OccName ( OccName, dataName, isTcOcc )
import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv,
GenAvailInfo(..), AvailInfo, Avails,
- IsBootInterface, WhetherHasOrphans,
+ IsBootInterface,
availName, availNames, availsToNameSet,
- Deprecations(..), ModIface(..),
+ Deprecations(..), ModIface(..), Dependencies(..),
GlobalRdrElt(..), unQualInScope, isLocalGRE
)
import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
avails_by_module = mi_exports iface
deprecs = mi_deprecs iface
is_orph = mi_orphan iface
+ deps = mi_deps iface
avails :: Avails
avails = [ avail | (mod_name, avails) <- avails_by_module,
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
+ orphans | is_orph = insert imp_mod_name (dep_orphs deps)
+ | otherwise = dep_orphs deps
- -- 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
-- (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)
+ ((imp_mod_name, is_boot) : filter not_self (dep_mods deps), dep_pkgs deps)
+
| 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)
+ -- Dump the dependent modules
-- 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)
+ ([], insert (mi_package iface) (dep_pkgs deps))
- not_self (m, _, _) = m /= this_mod_name
- sub_is_orph (_, orph, _) = orph
+ not_self (m, _) = m /= this_mod_name
import_all = case imp_spec of
(Just (False, _)) -> False -- Imports are spec'd explicitly
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 ...
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 }
+ imp_orphs = orphans,
+ imp_dep_mods = mkModDeps dependent_mods,
+ imp_dep_pkgs = dependent_pkgs }
in
-- Complain if we import a deprecated module
returnM (gbl_env, imports)
}
-mkModDeps :: [(ModuleName, WhetherHasOrphans, IsBootInterface)]
- -> ModuleEnv (ModuleName, WhetherHasOrphans, IsBootInterface)
+mkModDeps :: [(ModuleName, IsBootInterface)]
+ -> ModuleEnv (ModuleName, IsBootInterface)
mkModDeps deps = foldl add emptyModuleEnv deps
where
- add env elt@(m,_,_) = extendModuleEnvByName env m elt
+ add env elt@(m,_) = extendModuleEnvByName env m elt
\end{code}
ModIface, ModDetails(..), ModGuts(..),
HscEnv(..),
ModIface(..), ModDetails(..), IfaceDecls(..),
- GhciMode(..),
+ GhciMode(..), Dependencies(..), noDependencies,
Deprecations(..), plusDeprecs,
emptyGlobalRdrEnv,
GenAvailInfo(Avail), availsToNameSet,
updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
tcg_imports = tcg_imports gbl `plusImportAvails` imports })
$ do {
- traceRn (text "rn1" <+> ppr (dep_mods imports)) ;
+ traceRn (text "rn1" <+> ppr (imp_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
mod_guts = ModGuts { mg_module = this_mod,
mg_usages = [], -- ToDo: compute usage
mg_dir_imps = [], -- ??
- mg_deps = ([],[]), -- ??
+ mg_deps = noDependencies, -- ??
mg_exports = my_exports,
mg_types = final_type_env,
mg_insts = tcg_insts tcg_env,
, ppr_insts dfun_ids
, vcat (map ppr rules)
, ppr_gen_tycons (typeEnvTyCons type_env)
- , ppr (moduleEnvElts (dep_mods imports))
- , ppr (dep_pkgs imports)]
+ , ppr (moduleEnvElts (imp_dep_mods imports))
+ , ppr (imp_dep_pkgs imports)]
pprModGuts :: ModGuts -> SDoc
pprModGuts (ModGuts { mg_types = type_env,
import HscTypes ( GhciMode, ExternalPackageState, HomePackageTable, NameCache,
GlobalRdrEnv, LocalRdrEnv, FixityEnv, TypeEnv, TyThing,
Avails, GenAvailInfo(..), AvailInfo, availName,
- IsBootInterface, Deprecations, WhetherHasOrphans )
+ IsBootInterface, Deprecations )
import Packages ( PackageName )
import TcType ( TcTyVarSet, TcType, TcTauType, TcThetaType, TcPredType, TcKind,
tcCmpPred, tcCmpType, tcCmpTypes )
import FIX_IO ( fixIO )
import EXCEPTION ( Exception )
import Maybe ( mapMaybe )
-import List ( nub )
+import ListSetOps ( unionLists )
import Panic ( tryMost )
\end{code}
-- 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
+ imp_dep_mods :: ModuleEnv (ModuleName, IsBootInterface),
+ -- Home-package modules needed by the module being compiled
--
-- It doesn't matter whether any of these dependencies are actually
-- *used* when compiling the module; they are listed if they are below
-- compiling M might not need to consult X.hi, but X is still listed
-- in M's dependencies.
- dep_pkgs :: [PackageName]
+ imp_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.
+
+ imp_orphs :: [ModuleName]
+ -- Orphan modules below us in the import tree
}
emptyImportAvails :: ImportAvails
-emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv,
- imp_unqual = emptyModuleEnv,
- imp_mods = emptyModuleEnv,
- dep_mods = emptyModuleEnv,
- dep_pkgs = [] }
+emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv,
+ imp_unqual = emptyModuleEnv,
+ imp_mods = emptyModuleEnv,
+ imp_dep_mods = emptyModuleEnv,
+ imp_dep_pkgs = [],
+ imp_orphs = [] }
plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
plusImportAvails
(ImportAvails { imp_env = env1, imp_unqual = unqual1, imp_mods = mods1,
- dep_mods = dmods1, dep_pkgs = dpkgs1 })
+ imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1, imp_orphs = orphs1 })
(ImportAvails { imp_env = env2, imp_unqual = unqual2, imp_mods = mods2,
- dep_mods = dmods2, dep_pkgs = dpkgs2 })
+ imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2, imp_orphs = orphs2 })
= ImportAvails { imp_env = env1 `plusAvailEnv` env2,
imp_unqual = plusModuleEnv_C plusAvailEnv unqual1 unqual2,
imp_mods = mods1 `plusModuleEnv` mods2,
- dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2,
- dep_pkgs = nub (dpkgs1 ++ dpkgs2) }
+ imp_dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2,
+ imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
+ imp_orphs = orphs1 `unionLists` orphs2 }
where
- plus_mod_dep (m1, orphan1, boot1) (m2, orphan2, boot2)
- = WARN( not (m1 == m2 && (boot1 || boot2 || orphan1 == orphan2)),
- (ppr m1 <+> ppr m2) $$ (ppr orphan1 <+> ppr orphan2) $$ (ppr boot1 <+> ppr boot2) )
- -- Check mod-names match, and orphan-hood matches; but a boot interface
- -- might not know about orphan hood, so only check the orphan match
- -- if both are non-boot interfaces
- (m1, orphan1 || orphan2, boot1 && boot2)
- -- If either side can "see" a non-hi-boot interface, use that
- -- Similarly orphan-hood (see note about about why orphan1 and 2 might differ)
+ plus_mod_dep (m1, boot1) (m2, boot2)
+ = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
+ -- Check mod-names match
+ (m1, boot1 && boot2) -- If either side can "see" a non-hi-boot interface, use that
\end{code}
%************************************************************************
\begin{code}
plusAvail (Avail n1) (Avail n2) = Avail n1
-plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
+plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
-- Added SOF 4/97
#ifdef DEBUG
plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
projects / ghc-hetmet.git / commitdiff