+ load mod = loadInterface (pprModuleName mod <+> ptext SLIT("is a orphan-instance module")) mod ImportBySystem
+
+loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Module, Ifaces)
+loadInterface doc_str mod_name from
+ = getIfacesRn `thenRn` \ ifaces ->
+ let
+ mod_map = iImpModInfo ifaces
+ mod_info = lookupFM mod_map mod_name
+
+ hi_boot_file = case from of {
+ ImportByUser -> False ; -- Not hi-boot
+ ImportByUserSource -> True ; -- hi-boot
+ ImportBySystem ->
+ case mod_info of
+ Just (_, _, is_boot, _) -> is_boot
+
+ 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
+ -- dependency tracking. So it won't be a hi-boot file.
+ }
+ redundant_source_import
+ = case (from, mod_info) of
+ (ImportByUserSource, Just (_,_,False,_)) -> True
+ other -> False
+ in
+ -- CHECK WHETHER WE HAVE IT ALREADY
+ case mod_info of {
+ Just (_, _, _, Just (load_mod, _, _))
+ -> -- We're read it already so don't re-read it
+ returnRn (load_mod, ifaces) ;
+
+ _ ->
+
+ -- Issue a warning for a redundant {- SOURCE -} import
+ -- NB that we arrange to read all the ordinary imports before
+ -- any of the {- SOURCE -} imports
+ warnCheckRn (not redundant_source_import)
+ (warnRedundantSourceImport mod_name) `thenRn_`
+
+ -- READ THE MODULE IN
+ findAndReadIface doc_str mod_name hi_boot_file `thenRn` \ read_result ->
+ case read_result of {
+ Nothing -> -- Not found, so add an empty export env to the Ifaces map
+ -- so that we don't look again
+ let
+ mod = mkVanillaModule mod_name
+ new_mod_map = addToFM mod_map mod_name (0, False, False, Just (mod, from, []))
+ new_ifaces = ifaces { iImpModInfo = new_mod_map }
+ in
+ setIfacesRn new_ifaces `thenRn_`
+ failWithRn (mod, new_ifaces) (noIfaceErr mod hi_boot_file) ;
+
+ -- Found and parsed!
+ Just iface ->
+
+ -- LOAD IT INTO Ifaces
+
+ -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
+ --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
+ -- If we do loadExport first the wrong info gets into the cache (unless we
+ -- explicitly tag each export which seems a bit of a bore)
+
+ getModuleRn `thenRn` \ this_mod_nm ->
+ let
+ rd_decls = pi_decls iface
+ mod = pi_mod iface
+ in
+ -- Sanity check. If we're system-importing a module we know nothing at all
+ -- about, it should be from a different package to this one
+ WARN( not (maybeToBool mod_info) &&
+ case from of { ImportBySystem -> True; other -> False } &&
+ isLocalModule mod,
+ ppr mod )
+ foldlRn (loadDecl mod) (iDecls ifaces) rd_decls `thenRn` \ new_decls ->
+ foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
+ (if opt_IgnoreIfacePragmas
+ then returnRn emptyBag
+ else foldlRn (loadRule mod) (iRules ifaces) (pi_rules iface)) `thenRn` \ new_rules ->
+ (if opt_IgnoreIfacePragmas
+ then returnRn emptyNameEnv
+ else foldlRn (loadDeprec mod) (iDeprecs ifaces) (pi_deprecs iface)) `thenRn` \ new_deprecs ->
+ foldlRn (loadFixDecl mod_name) (iFixes ifaces) rd_decls `thenRn` \ new_fixities ->
+ mapRn (loadExport this_mod_nm) (pi_exports iface) `thenRn` \ avails_s ->
+ let
+ -- For an explicit user import, add to mod_map info about
+ -- the things the imported module depends on, extracted
+ -- from its usage info.
+ mod_map1 = case from of
+ ImportByUser -> addModDeps mod (pi_usages iface) mod_map
+ other -> mod_map
+
+ -- Now add info about this module
+ mod_map2 = addToFM mod_map1 mod_name mod_details
+ cts = (pi_mod iface, from, concat avails_s)
+ mod_details = (pi_vers iface, pi_orphan iface, hi_boot_file, Just cts)
+
+ new_ifaces = ifaces { iImpModInfo = mod_map2,
+ iDecls = new_decls,
+ iFixes = new_fixities,
+ iInsts = new_insts,
+ iRules = new_rules,
+ iDeprecs = new_deprecs }
+ in
+ setIfacesRn new_ifaces `thenRn_`
+ returnRn (mod, new_ifaces)
+ }}
+
+addModDeps :: Module -> [ImportVersion a]
+ -> ImportedModuleInfo -> ImportedModuleInfo
+-- (addModDeps M ivs deps)
+-- We are importing module M, and M.hi contains 'import' decls given by ivs
+addModDeps mod 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
+ | isLocalModule mod = [ (imp_mod, (version, has_orphans, is_boot, Nothing))
+ | (imp_mod, version, has_orphans, is_boot, _) <- new_deps
+ ]
+ | otherwise = [ (imp_mod, (version, True, False, Nothing))
+ | (imp_mod, version, has_orphans, _, _) <- new_deps,
+ has_orphans
+ ]
+ add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep
+
+ combine old@(_, _, old_is_boot, cts) new
+ | maybeToBool cts || not old_is_boot = old -- Keep the old info if it's already loaded
+ -- or if it's a non-boot pending load
+ | otherwise = new -- Otherwise pick new info
+
+loadExport :: ModuleName -> ExportItem -> RnM d [AvailInfo]
+loadExport this_mod (mod, entities)
+ | mod == this_mod = returnRn []
+ -- 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
+ -- filter them out up front. This situation only arises if a module
+ -- imports itself, or another module that imported it. (Necessarily,
+ -- this invoves a loop.) Consequence: if you say
+ -- module A where
+ -- import B( AType )
+ -- type AType = ...
+ --
+ -- module B( AType ) where
+ -- import {-# SOURCE #-} A( AType )
+ --
+ -- then you'll get a 'B does not export AType' message. A bit bogus
+ -- but it's a bogus thing to do!
+
+ | otherwise
+ = mapRn (load_entity mod) entities
+ where
+ new_name mod occ = mkImportedGlobalName mod occ
+
+ load_entity mod (Avail occ)
+ = new_name mod occ `thenRn` \ name ->
+ returnRn (Avail name)
+ load_entity mod (AvailTC occ occs)
+ = new_name mod occ `thenRn` \ name ->
+ mapRn (new_name mod) occs `thenRn` \ names ->
+ returnRn (AvailTC name names)
+
+
+loadFixDecl :: ModuleName -> FixityEnv
+ -> (Version, RdrNameHsDecl)
+ -> RnM d FixityEnv
+loadFixDecl mod_name fixity_env (version, FixD sig@(FixitySig rdr_name fixity loc))
+ = -- Ignore the version; when the fixity changes the version of
+ -- its 'host' entity changes, so we don't need a separate version
+ -- number for fixities
+ mkImportedGlobalName mod_name (rdrNameOcc rdr_name) `thenRn` \ name ->
+ let
+ new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
+ in
+ returnRn new_fixity_env