[project @ 2001-05-01 09:16:55 by qrczak]
[ghc-hetmet.git] / ghc / compiler / rename / RnHiFiles.lhs
index 42240c1..4477e89 100644 (file)
@@ -17,10 +17,11 @@ module RnHiFiles (
 
 #include "HsVersions.h"
 
+import DriverUtil      ( splitFilename )
 import CmdLineOpts     ( opt_IgnoreIfacePragmas )
 import HscTypes                ( ModuleLocation(..),
                          ModIface(..), emptyModIface,
-                         VersionInfo(..),
+                         VersionInfo(..), ImportedModuleInfo,
                          lookupIfaceByModName, 
                          ImportVersion, WhetherHasOrphans, IsBootInterface,
                          DeclsMap, GatedDecl, IfaceInsts, IfaceRules,
@@ -36,19 +37,18 @@ import RdrHsSyn             ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl,
 import BasicTypes      ( Version, defaultFixity )
 import RnEnv
 import RnMonad
-import ParseIface      ( parseIface, IfaceStuff(..) )
+import ParseIface      ( parseIface )
 
-import Name            ( Name {-instance NamedThing-}, nameOccName,
-                         nameModule, isLocalName, nameIsLocalOrFrom,
-                         NamedThing(..),
+import Name            ( Name {-instance NamedThing-}, 
+                         nameModule, isLocalName, nameIsLocalOrFrom
                         )
-import Name            ( mkNameEnv, extendNameEnv )
+import NameEnv
 import Module          ( Module, 
                          moduleName, isHomeModule,
                          ModuleName, WhereFrom(..),
                          extendModuleEnv, mkVanillaModule
                        )
-import RdrName         ( RdrName, rdrNameOcc )
+import RdrName         ( rdrNameOcc )
 import SrcLoc          ( mkSrcLoc )
 import Maybes          ( maybeToBool, orElse )
 import StringBuffer     ( hGetStringBuffer )
@@ -93,7 +93,10 @@ loadInterface doc mod from
   = tryLoadInterface doc mod from      `thenRn` \ (ifaces, maybe_err) ->
     case maybe_err of
        Nothing  -> returnRn ifaces
-       Just err -> failWithRn ifaces err
+       Just err -> failWithRn ifaces (elaborate err)
+  where
+    elaborate err = hang (ptext SLIT("failed to load interface for") <+> quotes (ppr mod) <> colon)
+                        4 err
 
 tryLoadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (ModIface, Maybe Message)
   -- Returns (Just err) if an error happened
@@ -106,6 +109,7 @@ tryLoadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (ModIface, Maybe Me
   -- (If the load fails, we plug in a vanilla placeholder)
 tryLoadInterface doc_str mod_name from
  = getHomeIfaceTableRn         `thenRn` \ hit ->
+   getModuleRn                 `thenRn` \ this_mod ->
    getIfacesRn                         `thenRn` \ ifaces@(Ifaces { iPIT = pit }) ->
 
        -- CHECK WHETHER WE HAVE IT ALREADY
@@ -148,6 +152,13 @@ tryLoadInterface doc_str mod_name from
    warnCheckRn (not redundant_source_import)
                (warnRedundantSourceImport mod_name)    `thenRn_`
 
+       -- Check that we aren't importing ourselves. 
+       -- That only happens in Rename.checkOldIface, 
+       -- which doesn't call tryLoadInterface
+   warnCheckRn 
+       (not (isHomeModule this_mod) || moduleName this_mod /= mod_name)
+       (warnSelfImport this_mod)               `thenRn_`
+
        -- READ THE MODULE IN
    findAndReadIface doc_str mod_name hi_boot_file   `thenRn` \ read_result ->
    case read_result of {
@@ -198,7 +209,14 @@ tryLoadInterface doc_str mod_name from
                        ImportByUser -> addModDeps mod is_loaded (pi_usages iface) mod_map
                        other        -> mod_map
        mod_map2 = delFromFM mod_map1 mod_name
-       is_loaded m = maybeToBool (lookupIfaceByModName hit pit m)
+
+       this_mod_name = moduleName this_mod
+       is_loaded m   =  m == this_mod_name 
+                     || maybeToBool (lookupIfaceByModName hit pit m)
+               -- We treat the currently-being-compiled module as 'loaded' because
+               -- even though it isn't yet in the HIT or PIT; otherwise it gets
+               -- put into iImpModInfo, and then spat out into its own interface
+               -- file as a dependency
 
        -- Now add info about this module to the PIT
        has_orphans = pi_orphan iface
@@ -228,7 +246,7 @@ tryLoadInterface doc_str mod_name from
 -----------------------------------------------------
 
 addModDeps :: Module 
-          -> (ModuleName -> Bool)      -- True for module interfaces
+          -> (ModuleName -> Bool)      -- True for modules that are already loaded
           -> [ImportVersion a] 
           -> ImportedModuleInfo -> ImportedModuleInfo
 -- (addModDeps M ivs deps)
@@ -241,8 +259,7 @@ addModDeps mod is_loaded new_deps mod_deps
        -- and in that case, forget about the boot indicator
     filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
     filtered_new_deps
-       | isHomeModule mod 
-                           = [ (imp_mod, (has_orphans, is_boot))
+       | isHomeModule mod  = [ (imp_mod, (has_orphans, is_boot))
                              | (imp_mod, has_orphans, is_boot, _) <- new_deps,
                                not (is_loaded imp_mod)
                              ]                       
@@ -262,13 +279,12 @@ addModDeps mod is_loaded new_deps mod_deps
 
 loadExports :: (Version, [ExportItem]) -> RnM d (Version, [(ModuleName,Avails)])
 loadExports (vers, items)
-  = getModuleRn                                `thenRn` \ this_mod ->
-    mapRn (loadExport this_mod) items          `thenRn` \ avails_s ->
+  = mapRn loadExport items     `thenRn` \ avails_s ->
     returnRn (vers, avails_s)
 
 
-loadExport :: Module -> ExportItem -> RnM d (ModuleName, Avails)
-loadExport this_mod (mod, entities)
+loadExport :: ExportItem -> RnM d (ModuleName, Avails)
+loadExport (mod, entities)
   = mapRn (load_entity mod) entities   `thenRn` \ avails ->
     returnRn (mod, avails)
   where
@@ -419,6 +435,9 @@ It's used for both source code (from @availsFromDecl@) and interface files
 It doesn't deal with source-code specific things: @ValD@, @DefD@.  They
 are handled by the sourc-code specific stuff in @RnNames@.
 
+       *** See "THE NAMING STORY" in HsDecls ****
+
+
 \begin{code}
 getTyClDeclBinders
        :: Module
@@ -489,9 +508,10 @@ mkHiPath hi_boot_file locn
        if b then returnRn hi_boot_ver_path
             else returnRn hi_boot_path
   | otherwise    = returnRn hi_path
-       where (Just hi_path)   = ml_hi_file locn
-             hi_boot_path     = hi_path ++ "-boot"
-             hi_boot_ver_path = hi_path ++ "-boot-" ++ cHscIfaceFileVersion
+       where (Just hi_path)    = ml_hi_file locn
+             (hi_base, hi_suf) = splitFilename hi_path
+             hi_boot_path      = hi_base ++ ".hi-boot"
+             hi_boot_ver_path  = hi_base ++ ".hi-boot-" ++ cHscIfaceFileVersion
 \end{code}
 
 @readIface@ tries just the one file.
@@ -501,7 +521,8 @@ readIface :: String -> RnM d (Either Message ParsedIface)
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
 readIface file_path
-  = traceRn (ptext SLIT("readIFace") <+> text file_path)       `thenRn_` 
+  = --ioToRnM (putStrLn ("reading iface " ++ file_path)) `thenRn_`
+    traceRn (ptext SLIT("readIFace") <+> text file_path)       `thenRn_` 
 
     ioToRnM (hGetStringBuffer False file_path)                 `thenRn` \ read_result ->
     case read_result of {
@@ -509,13 +530,8 @@ readIface file_path
        Right contents -> 
 
     case parseIface contents init_parser_state of
-       POk _ (PIface iface) -> returnRn (Right iface)
+       POk _ iface          -> returnRn (Right iface)
        PFailed err          -> bale_out err
-       parse_result         -> bale_out empty
-               -- This last case can happen if the interface file is (say) empty
-               -- in which case the parser thinks it looks like an IdInfo or
-               -- something like that.  Just an artefact of the fact that the
-               -- parser is used for several purposes at once.
     }
   where
     init_parser_state = PState{ bol = 0#, atbol = 1#,
@@ -601,5 +617,8 @@ hiModuleNameMismatchWarn requested_mod read_mod =
 warnRedundantSourceImport mod_name
   = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
           <+> quotes (ppr mod_name)
+
+warnSelfImport mod
+  = ptext SLIT("Importing my own interface: module") <+> ppr mod
 \end{code}