From 94ff1ec1546169fc839b2318c0d141f3089d3e26 Mon Sep 17 00:00:00 2001 From: sof Date: Tue, 2 Mar 1999 17:12:58 +0000 Subject: [PATCH] [project @ 1999-03-02 17:12:54 by sof] Directories can now be flagged as containing interface files that have their corresponding object codes living in Win32 DLLs. The compiler needs to keep track of whether a name refers to something in a DLL or not, since Win32 DLLs forces you to distinguish between the two at the point of use. For example, the code generated for the following snippet return (x+2); will differ. If 'x' resides in a DLL, you need to perform an extra indirection to get at its value. Effectively, the generated code becomes return (*x+2); For functions, the distinction can be made transparent, but we can avoid jumping through an extra level of indirection if we do indicate that a label will be imported from a DLL. Back to the renamer and its scheme, directories that contain the file ".dLL_ifs.hi" (name chosen to lessen the risk of a clash..) are considered as containing 'DLL interface files'. There's two caveats to this scheme: - interface files found in "." are not considered to be referring to something in a DLL. - if the compiler has got -static on the command line, then all interface file in scope are considered to be 'normal'. --- ghc/compiler/rename/ParseIface.y | 19 +++--- ghc/compiler/rename/Rename.lhs | 3 +- ghc/compiler/rename/RnEnv.lhs | 10 ++-- ghc/compiler/rename/RnIfaces.lhs | 118 ++++++++++++++++++++++---------------- ghc/compiler/rename/RnMonad.lhs | 95 ++++++++++++++++++++++++------ ghc/compiler/rename/RnNames.lhs | 3 +- 6 files changed, 164 insertions(+), 84 deletions(-) diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y index 8b8a622..8fc0631 100644 --- a/ghc/compiler/rename/ParseIface.y +++ b/ghc/compiler/rename/ParseIface.y @@ -24,12 +24,12 @@ import RnMonad ( ImportVersion, LocalVersion, ParsedIface(..), WhatsImported(.. import Bag ( emptyBag, unitBag, snocBag ) import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap ) import RdrName ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual ) -import Name ( OccName, Provenance, Module ) -import OccName ( mkSysModuleFS, mkSysOccFS, +import Name ( OccName, Provenance ) +import OccName ( mkSysOccFS, tcName, varName, dataName, clsName, tvName, - IfaceFlavour, hiFile, hiBootFile, EncodedFS ) +import Module ( Module, mkSysModuleFS, IfaceFlavour, hiFile, hiBootFile ) import PrelMods ( mkTupNameStr, mkUbxTupNameStr ) import PrelInfo ( mkTupConRdrName, mkUbxTupConRdrName ) import SrcLoc ( SrcLoc ) @@ -151,26 +151,27 @@ import Ratio ( (%) ) -- (c) the IdInfo part of a signature (same reason) iface_stuff :: { IfaceStuff } -iface_stuff : iface { PIface $1 } +iface_stuff : iface { let (nm, iff) = $1 in PIface nm iff } | type { PType $1 } | id_info { PIdInfo $1 } -iface :: { ParsedIface } -iface : '__interface' mod_name INTEGER checkVersion 'where' +iface :: { (EncodedFS, ParsedIface) } +iface : '__interface' mod_fs INTEGER checkVersion 'where' import_part instance_import_part exports_part instance_decl_part decls_part - { ParsedIface - $2 -- Module name + { ( $2 -- Module name + , ParsedIface (fromInteger $3) -- Module version (reverse $6) -- Usages (reverse $8) -- Exports (reverse $7) -- Instance import modules (reverse $10) -- Decls (reverse $9) -- Local instances + ) } -------------------------------------------------------------------------- @@ -718,7 +719,7 @@ checkVersion :: { () } -- Haskell code { -data IfaceStuff = PIface ParsedIface +data IfaceStuff = PIface EncodedFS{-.hi module name-} ParsedIface | PIdInfo [HsIdInfo RdrName] | PType RdrNameHsType diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 1ca1b27..5474e17 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -26,9 +26,10 @@ import RnIfaces ( getImportedInstDecls, importDecl, getImportVersions, getSpeci import RnEnv ( addImplicitOccsRn, availName, availNames, availsToNameSet, warnUnusedTopNames ) +import Module ( pprModule ) import Name ( Name, isLocallyDefined, NamedThing(..), ImportReason(..), Provenance(..), - nameModule, pprModule, pprOccName, nameOccName, + nameModule, pprOccName, nameOccName, getNameProvenance, occNameUserString, ) import RdrName ( RdrName ) diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 6e75fbe..53bf1bc 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -26,8 +26,9 @@ import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..), import NameSet import OccName ( OccName, mkDFunOcc, - occNameFlavour, moduleIfaceFlavour + occNameFlavour ) +import Module ( moduleIfaceFlavour ) import TyCon ( TyCon ) import FiniteMap import Unique ( Unique, Uniquable(..), unboundKey ) @@ -49,14 +50,12 @@ import Maybes ( mapMaybe ) %********************************************************* \begin{code} -newImportedGlobalName :: Module -> OccName - -> RnM s d Name +newImportedGlobalName :: Module -> OccName -> RnM s d Name newImportedGlobalName mod occ = -- First check the cache getNameSupplyRn `thenRn` \ (us, inst_ns, cache) -> let key = (mod,occ) - mod_hif = moduleIfaceFlavour mod in case lookupFM cache key of @@ -83,10 +82,11 @@ newImportedGlobalName mod occ Nothing -> -- Miss in the cache! -- Build a new original name, and put it in the cache getOmitQualFn `thenRn` \ omit_fn -> + setModuleFlavourRn mod `thenRn` \ mod' -> let (us', us1) = splitUniqSupply us uniq = uniqFromSupply us1 - name = mkGlobalName uniq mod occ (NonLocalDef ImplicitImport (omit_fn name)) + name = mkGlobalName uniq mod' occ (NonLocalDef ImplicitImport (omit_fn name)) -- For in-scope things we improve the provenance -- in RnNames.importsFromImportDecl new_cache = addToFM cache key name diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index 5b3c299..f507e6a 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -44,12 +44,14 @@ import FiniteMap ( FiniteMap, sizeFM, emptyFM, delFromFM, fmToList ) import Name ( Name {-instance NamedThing-}, - nameModule, moduleUserString, pprModule, isLocallyDefined, - isWiredInName, maybeWiredInTyConName, pprModule, - maybeWiredInIdName, nameUnique, NamedThing(..) + nameModule, isLocallyDefined, + isWiredInName, maybeWiredInTyConName, + maybeWiredInIdName, nameUnique, NamedThing(..), + pprEncodedFS ) -import OccName ( Module, mkBootModule, - moduleIfaceFlavour, bootFlavour, hiFile +import Module ( Module, mkBootModule, moduleString, pprModule, + mkDynamicModule, moduleIfaceFlavour, bootFlavour, hiFile, + moduleUserString, moduleFS, setModuleFlavour ) import RdrName ( RdrName, rdrNameOcc ) import NameSet @@ -162,16 +164,15 @@ count_decls decls %********************************************************* \begin{code} -loadHomeInterface :: SDoc -> Name -> RnMG Ifaces +loadHomeInterface :: SDoc -> Name -> RnMG (Module, Ifaces) loadHomeInterface doc_str name = loadInterface doc_str (nameModule name) -loadInterface :: SDoc -> Module -> RnMG Ifaces +loadInterface :: SDoc -> Module -> RnMG (Module, Ifaces) loadInterface doc_str load_mod = getIfacesRn `thenRn` \ ifaces -> let new_hif = moduleIfaceFlavour load_mod - this_mod = iMod ifaces mod_map = iModMap ifaces (insts, tycls_names) = iDefInsts ifaces in @@ -181,7 +182,7 @@ loadInterface doc_str load_mod | bootFlavour new_hif || not (bootFlavour existing_hif) -> -- Already in the cache, and new version is no better than old, -- so don't re-read it - returnRn ifaces ; + returnRn (setModuleFlavour existing_hif load_mod, ifaces) ; other -> -- READ THE MODULE IN @@ -195,10 +196,11 @@ loadInterface doc_str load_mod new_ifaces = ifaces { iModMap = new_mod_map } in setIfacesRn new_ifaces `thenRn_` - failWithRn new_ifaces (noIfaceErr load_mod) ; + failWithRn (load_mod, new_ifaces) (noIfaceErr load_mod) ; -- Found and parsed! - Just (ParsedIface _ mod_vers usages exports rd_inst_mods rd_decls rd_insts) -> + Just (the_mod, ParsedIface mod_vers usages exports rd_inst_mods rd_decls rd_insts) -> + -- LOAD IT INTO Ifaces -- First set the module @@ -209,7 +211,7 @@ loadInterface doc_str load_mod -- explicitly tag each export which seems a bit of a bore) getModuleRn `thenRn` \ this_mod -> - setModuleRn load_mod $ -- First set the module name of the module being loaded, + 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 -> @@ -218,19 +220,22 @@ loadInterface doc_str load_mod mapRn (loadExport this_mod) exports `thenRn` \ avails_s -> let - mod_details = (new_hif, mod_vers, concat avails_s) + -- 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 load_mod mod_details, + 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 new_ifaces + returnRn (the_mod, new_ifaces) }} loadExport :: Module -> ExportItem -> RnMG [AvailInfo] @@ -253,16 +258,17 @@ loadExport this_mod (mod, entities) -- but it's a bogus thing to do! | otherwise - = mapRn load_entity entities + = setModuleFlavourRn mod `thenRn` \ mod' -> + mapRn (load_entity mod') entities where - new_name occ = newImportedGlobalName mod occ + new_name mod occ = newImportedGlobalName mod occ - load_entity (Avail occ) - = new_name occ `thenRn` \ name -> + load_entity mod (Avail occ) + = new_name mod occ `thenRn` \ name -> returnRn (Avail name) - load_entity (AvailTC occ occs) - = new_name occ `thenRn` \ name -> - mapRn new_name occs `thenRn` \ names -> + load_entity mod (AvailTC occ occs) + = new_name mod occ `thenRn` \ name -> + mapRn (new_name mod) occs `thenRn` \ names -> returnRn (AvailTC name names) @@ -377,7 +383,7 @@ checkUpToDate mod_name pprModule mod_name]) `thenRn_` returnRn False - Just (ParsedIface _ _ usages _ _ _ _) + Just (_, ParsedIface _ usages _ _ _ _) -> -- Found it, so now check it checkModUsage usages where @@ -387,7 +393,7 @@ checkUpToDate mod_name checkModUsage [] = returnRn True -- Yes! Everything is up to date! checkModUsage ((mod, old_mod_vers, whats_imported) : rest) - = loadInterface doc_str mod `thenRn` \ ifaces -> + = loadInterface doc_str mod `thenRn` \ (mod, ifaces) -> let maybe_new_mod_vers = lookupFM (iModMap ifaces) mod Just (_, new_mod_vers, _) = maybe_new_mod_vers @@ -488,7 +494,7 @@ importDecl (name, loc) mode getNonWiredInDecl :: Name -> SrcLoc -> RnMode -> RnMG (Maybe RdrNameHsDecl) getNonWiredInDecl needed_name loc mode = traceRn doc_str `thenRn_` - loadHomeInterface doc_str needed_name `thenRn` \ ifaces -> + loadHomeInterface doc_str needed_name `thenRn` \ (_, ifaces) -> case lookupNameEnv (iDecls ifaces) needed_name of -- Special case for data/newtype type declarations @@ -630,17 +636,17 @@ get_wired_tycon tycon %********************************************************* \begin{code} -getInterfaceExports :: Module -> RnMG Avails +getInterfaceExports :: Module -> RnMG (Module, Avails) getInterfaceExports mod - = loadInterface doc_str mod `thenRn` \ ifaces -> + = loadInterface doc_str mod `thenRn` \ (mod, ifaces) -> case lookupFM (iModMap ifaces) mod of Nothing -> -- Not there; it must be that the interface file wasn't found; -- the error will have been reported already. -- (Actually loadInterface should put the empty export env in there -- anyway, but this does no harm.) - returnRn [] + returnRn (mod, []) - Just (_, _, avails) -> returnRn avails + Just (_, _, avails) -> returnRn (mod, avails) where doc_str = sep [pprModule mod, ptext SLIT("is directly imported")] \end{code} @@ -1031,7 +1037,7 @@ getDeclSysBinders new_name other_decl %********************************************************* \begin{code} -findAndReadIface :: SDoc -> Module -> RnMG (Maybe ParsedIface) +findAndReadIface :: SDoc -> Module -> RnMG (Maybe (Module, ParsedIface)) -- Nothing <=> file not found, or unreadable, or illegible -- Just x <=> successfully found and parsed @@ -1043,7 +1049,7 @@ findAndReadIface doc_str mod_name getModuleHiMap from_hi_boot `thenRn` \ himap -> case (lookupFM himap (moduleUserString mod_name)) of -- Found the file - Just fpath -> readIface fpath + Just fpath -> readIface mod_name fpath -- 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 @@ -1067,27 +1073,40 @@ findAndReadIface doc_str mod_name @readIface@ tries just the one file. \begin{code} -readIface :: String -> RnMG (Maybe ParsedIface) +readIface :: Module -> (String, Bool) -> RnMG (Maybe (Module, ParsedIface)) -- Nothing <=> file not found, or unreadable, or illegible -- Just x <=> successfully found and parsed -readIface file_path +readIface requested_mod (file_path, is_dll) = ioToRnMG (hGetStringBuffer file_path) `thenRn` \ read_result -> case read_result of Right contents -> case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of - Failed err -> failWithRn Nothing err - Succeeded (PIface iface) -> - if opt_D_show_rn_imports then - putDocRn (hcat[ptext SLIT("Read "), text file_path]) `thenRn_` - returnRn (Just iface) - else - returnRn (Just iface) - - Left err -> - if isDoesNotExistError err then - returnRn Nothing - else - failWithRn Nothing (cannaeReadFile file_path err) + Failed err -> failWithRn Nothing err + Succeeded (PIface mod_nm iface) -> + (if mod_nm /= moduleFS requested_mod then + addWarnRn (hsep [ ptext SLIT("Something is amiss; requested module name") + , pprModule requested_mod + , ptext SLIT("differs from name found in the interface file ") + , pprEncodedFS mod_nm + ]) + else + returnRn ()) `thenRn_` + let + the_mod + | is_dll = mkDynamicModule requested_mod + | otherwise = requested_mod + in + if opt_D_show_rn_imports then + putDocRn (hcat[ptext SLIT("Read module "), pprEncodedFS mod_nm, + ptext SLIT(" from "), text file_path]) `thenRn_` + returnRn (Just (the_mod, iface)) + else + returnRn (Just (the_mod, iface)) + + Left err + | isDoesNotExistError err -> returnRn Nothing + | otherwise -> failWithRn Nothing (cannaeReadFile file_path err) + \end{code} %********************************************************* @@ -1107,9 +1126,10 @@ of (directory, suffix) pairs. For example: \begin{code} mkSearchPath :: Maybe String -> SearchPath -mkSearchPath Nothing = [(".",".hi")] -mkSearchPath (Just s) - = go s +mkSearchPath Nothing = [(".",".hi")] -- ToDo: default should be to look in + -- the directory the module we're compiling + -- lives. +mkSearchPath (Just s) = go s where go "" = [] go s = diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index feb0309..0e14f7a 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -32,12 +32,18 @@ import SrcLoc ( noSrcLoc ) import ErrUtils ( addShortErrLocLine, addShortWarnLocLine, pprBagOfErrors, ErrMsg, WarnMsg, Message ) -import Name ( Module, Name, OccName, NamedThing(..), IfaceFlavour, - isLocallyDefinedName, nameModule, nameOccName +import Name ( Name, OccName, NamedThing(..), + isLocallyDefinedName, nameModule, nameOccName, + decode + ) +import Module ( Module, IfaceFlavour, setModuleFlavour, mkSysModuleFS, + bootFlavour, moduleString, moduleIfaceFlavour, mkDynFlavour ) import NameSet import RdrName ( RdrName ) -import CmdLineOpts ( opt_D_show_rn_trace, opt_IgnoreIfacePragmas, opt_WarnHiShadows ) +import CmdLineOpts ( opt_D_show_rn_trace, opt_IgnoreIfacePragmas, + opt_WarnHiShadows, opt_Static + ) import PrelInfo ( builtinNames ) import TysWiredIn ( boolTyCon ) import SrcLoc ( SrcLoc, mkGeneratedSrcLoc ) @@ -54,6 +60,7 @@ import UniqSupply import Util import Outputable import DirUtils ( getDirectoryContents ) +import Directory ( doesFileExist ) import IO ( hPutStrLn, stderr, isDoesNotExistError ) import Monad ( foldM ) import Maybe ( fromMaybe ) @@ -109,7 +116,9 @@ data RnDown s = RnDown { rn_ns :: SSTRef s RnNameSupply, rn_errs :: SSTRef s (Bag WarnMsg, Bag ErrMsg), rn_occs :: SSTRef s ([Occurrence],[Occurrence]), -- Occurrences: compulsory and optional resp - rn_mod :: Module + rn_hi_map :: ModuleHiMap, -- for .hi files + rn_hiboot_map :: ModuleHiMap, -- for .hi-boot files + rn_mod :: Module } type Occurrence = (Name, SrcLoc) -- The srcloc is the occurrence site @@ -120,8 +129,6 @@ data Necessity = Compulsory | Optional -- We *must* find definitions for -- For getting global names data GDown = GDown { - rn_hi_map :: ModuleHiMap, -- for .hi files - rn_hiboot_map :: ModuleHiMap, -- for .hi-boot files rn_ifaces :: SSTRWRef Ifaces } @@ -152,7 +159,7 @@ data RnMode = SourceMode -- Renaming source code type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search -- for interface files. -type ModuleHiMap = FiniteMap String String +type ModuleHiMap = FiniteMap String (String, Bool) -- mapping from module name to the file path of its corresponding -- interface file. \end{code} @@ -273,7 +280,6 @@ type LocalVersion name = (name, Version) data ParsedIface = ParsedIface - Module -- Module name Version -- Module version number [ImportVersion OccName] -- Usages [ExportItem] -- Exports @@ -285,6 +291,12 @@ type InterfaceDetails = (VersionInfo Name, -- Version information for what this ExportEnv, -- What this module exports [Module]) -- Instance modules + +-- needed by Main to fish out the fixities assoc list. +getIfaceFixities :: InterfaceDetails -> Fixities +getIfaceFixities (_, ExportEnv _ fs, _) = fs + + type RdrNamePragma = () -- Fudge for now ------------------- @@ -357,8 +369,9 @@ initRn mod us dirs loc do_rn = do let rn_down = RnDown { rn_loc = loc, rn_omit = \n -> False, rn_ns = names_var, rn_errs = errs_var, rn_occs = occs_var, + rn_hi_map = himap, rn_hiboot_map = hibmap, rn_mod = mod } - g_down = GDown { rn_hi_map = himap, rn_hiboot_map = hibmap, rn_ifaces = iface_var } + g_down = GDown {rn_ifaces = iface_var } -- do the business res <- sstToIO (do_rn rn_down g_down) @@ -402,24 +415,45 @@ initOccs = ([(getName boolTyCon, noSrcLoc)], []) -- to do as much as possible explicitly. \end{code} +We (allege) that it is quicker to build up a mapping from module names +to the paths to their corresponding interface files once, than to search +along the import part every time we slurp in a new module (which we +do quite a lot of.) + \begin{code} mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap) mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs where env = emptyFM +{- a pseudo file which signals that the interface files + contained in a particular directory have got their + corresponding object codes stashed away in a DLL + + This stuff is only needed to deal with Win32 DLLs, + and conceivably we conditionally compile in support + for handling it. (ToDo?) +-} +dir_contain_dll_his = "dLL_ifs.hi" + getAllFilesMatching :: SearchPath -> (ModuleHiMap, ModuleHiMap) -> (FilePath, String) -> IO (ModuleHiMap, ModuleHiMap) getAllFilesMatching dirs hims (dir_path, suffix) = ( do -- fpaths entries do not have dir_path prepended - fpaths <- getDirectoryContents dir_path - return (foldl addModules hims fpaths) + fpaths <- getDirectoryContents dir_path + is_dyns <- catch + (if dir_path == "." || opt_Static then + return False + else + doesFileExist (dir_path ++ '/': dir_contain_dll_his)) + (\ _ {-don't care-} -> return False) + return (foldl (addModules is_dyns) hims fpaths) ) -- soft failure `catch` (\ err -> do - hPutStrLn stderr + hPutStrLn stderr ("Import path element `" ++ dir_path ++ if (isDoesNotExistError err) then "' does not exist, ignoring." @@ -441,14 +475,14 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus hi_boot_xiffus = "toob-ih." -- .hi-boot reversed. - addModules his@(hi_env, hib_env) nm = fromMaybe his $ - FMAP (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env)) + addModules is_dll his@(hi_env, hib_env) nm = fromMaybe his $ + FMAP (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm (v, is_dll), hib_env)) (go xiffus rev_nm) `seqMaybe` - FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v)) + FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm (v,is_dll))) (go hi_boot_version_xiffus rev_nm) `seqMaybe` - FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v)) + FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm (v,is_dll))) (go hi_boot_xiffus rev_nm) where rev_nm = reverse nm @@ -468,7 +502,7 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do conflict old_path new_path | old_path /= new_path = - pprTrace "Warning: " (text "Identically named interface files present on import path, " $$ + pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$ text (show old_path) <+> text "shadows" $$ text (show new_path) $$ text "on the import path: " <+> @@ -857,10 +891,33 @@ setIfacesRn :: Ifaces -> RnMG () setIfacesRn ifaces rn_down (GDown {rn_ifaces = iface_var}) = writeMutVarSST iface_var ifaces -getModuleHiMap :: Bool -> RnMG ModuleHiMap -getModuleHiMap want_hi_boot rn_down (GDown {rn_hi_map = himap, rn_hiboot_map = hibmap}) +getModuleHiMap :: Bool -> RnM s d ModuleHiMap +getModuleHiMap want_hi_boot (RnDown {rn_hi_map = himap, rn_hiboot_map = hibmap}) _ | want_hi_boot = returnSST hibmap | otherwise = returnSST himap +\end{code} + +The interface file format is capable of distinguishing +between normal imports/exports of names from other modules +and 'hi-boot' mentions of names, with the flavour in the +being encoded inside a @Module@. + +@setModuleFlavourRn@ fixes up @Module@ values containing +normal flavours, checking to see whether + +\begin{code} +setModuleFlavourRn :: Module -> RnM s d Module +setModuleFlavourRn mod + | bootFlavour hif = returnRn mod + | otherwise = + getModuleHiMap (bootFlavour hif) `thenRn` \ himap -> + let mod_pstr = moduleString mod in + case (lookupFM himap mod_pstr) of + Nothing -> returnRn mod + Just (_,is_in_a_dll) -> + returnRn (setModuleFlavour (mkDynFlavour is_in_a_dll hif) mod) + where + hif = moduleIfaceFlavour mod \end{code} diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 2eb5a8d..881f497 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -34,6 +34,7 @@ import PrelMods import UniqFM ( lookupUFM ) import Bag ( bagToList ) import Maybes ( maybeToBool ) +import Module ( pprModule ) import NameSet import Name import RdrName ( RdrName, rdrNameOcc, mkRdrQual, mkRdrUnqual ) @@ -209,7 +210,7 @@ importsFromImportDecl :: RdrNameImportDecl importsFromImportDecl (ImportDecl imp_mod qual_only as_mod import_spec iloc) = pushSrcLocRn iloc $ - getInterfaceExports imp_mod `thenRn` \ avails -> + getInterfaceExports imp_mod `thenRn` \ (imp_mod, avails) -> if null avails then -- If there's an error in getInterfaceExports, (e.g. interface -- 1.7.10.4