-cachedIface :: IfaceCache
- -> Module
- -> IO (MaybeErr ParsedIface Error)
-
-cachedIface iface_cache mod
- = readVar iface_cache `thenPrimIO` \ (iface_fm, file_fm) ->
-
- case (lookupFM iface_fm mod) of
- Just iface -> return (Succeeded iface)
- Nothing ->
- case (lookupFM file_fm mod) of
- Nothing -> return (Failed (noIfaceErr mod))
- Just file ->
- readIface file mod >>= \ read_iface ->
- case read_iface of
- Failed err -> -- pprTrace "module-file map:\n" (ppAboves [ppCat [ppPStr m, ppStr f] | (m,f) <- fmToList file_fm]) $
- return (Failed err)
- Succeeded iface ->
- let
- iface_fm' = addToFM iface_fm mod iface
- in
- writeVar iface_cache (iface_fm', file_fm) `seqPrimIO`
- return (Succeeded iface)
-
-----------
-cachedDecl :: IfaceCache
- -> Bool -- True <=> tycon or class name
- -> RdrName
- -> IO (MaybeErr RdrIfaceDecl Error)
-
--- ToDo: this is where the check for Prelude.map being
--- located in PreludeList.map should be done ...
-
-cachedDecl iface_cache class_or_tycon orig
- = cachedIface iface_cache mod >>= \ maybe_iface ->
- case maybe_iface of
- Failed err -> return (Failed err)
- Succeeded (ParsedIface _ _ _ _ exps _ _ tdefs vdefs _ _) ->
- case (lookupFM (if class_or_tycon then tdefs else vdefs) str) of
- Just decl -> return (Succeeded decl)
- Nothing -> return (Failed (noDeclInIfaceErr mod str))
+loadHomeInterface :: SDoc -> Name -> RnMG (Module, Ifaces)
+loadHomeInterface doc_str name
+ = loadInterface doc_str (nameModule name)
+
+loadInterface :: SDoc -> Module -> RnMG (Module, Ifaces)
+loadInterface doc_str load_mod
+ = getIfacesRn `thenRn` \ ifaces ->
+ let
+ hi_boot_wanted = bootFlavour (moduleIfaceFlavour load_mod)
+ mod_map = iModMap ifaces
+ (insts, tycls_names) = iDefInsts ifaces
+
+ in
+ -- CHECK WHETHER WE HAVE IT ALREADY
+ case lookupFM mod_map load_mod of {
+ Just (existing_hif, _, _)
+ | hi_boot_wanted || not (bootFlavour existing_hif)
+ -> -- Already in the cache, and new version is no better than old,
+ -- so don't re-read it
+ returnRn (setModuleFlavour existing_hif load_mod, ifaces) ;
+ other ->
+
+ -- READ THE MODULE IN
+ findAndReadIface doc_str load_mod `thenRn` \ read_result ->
+ case read_result of {
+ Nothing | not hi_boot_wanted && load_mod `elem` thinAirModules
+ -> -- Hack alert! When compiling PrelBase we have to load the
+ -- decls for packCString# and friends; they are 'thin-air' Ids
+ -- (see PrelInfo.lhs). So if we don't find the HiFile we quietly
+ -- look for a .hi-boot file instead, and use that
+ --
+ -- NB this causes multiple "failed" attempts to read PrelPack,
+ -- which makes curious reading with -dshow-rn-trace, but
+ -- there's no harm done
+ loadInterface doc_str (mkBootModule load_mod)
+
+
+ | otherwise
+ -> -- Not found, so add an empty export env to the Ifaces map
+ -- so that we don't look again
+ let
+ new_mod_map = addToFM mod_map load_mod (hiFile, 0, [])
+ new_ifaces = ifaces { iModMap = new_mod_map }
+ in
+ setIfacesRn new_ifaces `thenRn_`
+ failWithRn (load_mod, new_ifaces) (noIfaceErr load_mod) ;
+
+ -- Found and parsed!
+ Just (the_mod, ParsedIface mod_vers usages exports rd_inst_mods rd_decls rd_insts) ->
+
+
+ -- LOAD IT INTO Ifaces
+ -- First set the module
+
+ -- 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 ->
+ setModuleRn the_mod $ -- First set the module name of the module being loaded,
+ -- so that unqualified occurrences in the interface file
+ -- get the right qualifer
+ foldlRn loadDecl (iDecls ifaces) rd_decls `thenRn` \ new_decls ->
+ foldlRn loadFixDecl (iFixes ifaces) rd_decls `thenRn` \ new_fixities ->
+ foldlRn loadInstDecl insts rd_insts `thenRn` \ new_insts ->
+
+ mapRn (loadExport this_mod) exports `thenRn` \ avails_s ->
+ let
+ -- Notice: the 'flavour' of the loaded Module does not have to
+ -- be the same as the requested Module.
+ the_mod_hif = moduleIfaceFlavour the_mod
+ mod_details = (the_mod_hif, mod_vers, concat avails_s)
+
+ -- Exclude this module from the "special-inst" modules
+ new_inst_mods = iInstMods ifaces `unionLists` (filter (/= this_mod) rd_inst_mods)
+
+ new_ifaces = ifaces { iModMap = addToFM mod_map the_mod mod_details,
+ iDecls = new_decls,
+ iFixes = new_fixities,
+ iDefInsts = (new_insts, tycls_names),
+ iInstMods = new_inst_mods }
+ in
+ setIfacesRn new_ifaces `thenRn_`
+ returnRn (the_mod, new_ifaces)
+ }}
+
+loadExport :: Module -> ExportItem -> RnMG [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
+ = setModuleFlavourRn mod `thenRn` \ mod' ->
+ mapRn (load_entity mod') entities