[project @ 2001-05-31 11:32:25 by simonmar]

[ghc-hetmet.git] / ghc / compiler / rename / RnHiFiles.lhs

diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index 240fa87..7e2a3db 100644 (file)
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -17,6 +17,7 @@ module RnHiFiles (
 
 #include "HsVersions.h"
 
+import DriverUtil      ( splitFilename )
 import CmdLineOpts     ( opt_IgnoreIfacePragmas )
 import HscTypes                ( ModuleLocation(..),
                          ModIface(..), emptyModIface,
@@ -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
@@ -115,6 +118,7 @@ tryLoadInterface doc_str mod_name from
                        ImportByUser       -> not (mi_boot iface)
                        ImportByUserSource -> mi_boot iface
                        ImportBySystem     -> True
+                       ImportByCmdLine    -> True
                   -> returnRn (iface, Nothing) ;       -- Already loaded
                        -- The not (mi_boot iface) test checks that the already-loaded
                        -- interface isn't a boot iface.  This can conceivably happen,
@@ -130,6 +134,7 @@ tryLoadInterface doc_str mod_name from
          = case (from, mod_info) of
                (ImportByUser,       _)             -> False    -- Not hi-boot
                (ImportByUserSource, _)             -> True     -- hi-boot
+               (ImportByCmdLine,    _)             -> False
                (ImportBySystem, Just (_, is_boot)) -> is_boot
                (ImportBySystem, Nothing)           -> False
                        -- We're importing a module we know absolutely
@@ -141,6 +146,9 @@ tryLoadInterface doc_str mod_name from
          = case (from, mod_info) of 
                (ImportByUserSource, Just (_,False)) -> True
                other                                -> False
+
+       home_allowed | ImportByCmdLine <- from = True
+                    | otherwise               = False
    in
 
        -- Issue a warning for a redundant {- SOURCE -} import
@@ -152,11 +160,13 @@ tryLoadInterface doc_str mod_name from
        -- Check that we aren't importing ourselves. 
        -- That only happens in Rename.checkOldIface, 
        -- which doesn't call tryLoadInterface
-   warnCheckRn (moduleName this_mod /= mod_name)
-               (warnSelfImport this_mod)               `thenRn_`
+   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 ->
+   findAndReadIface doc_str mod_name hi_boot_file home_allowed
+                                           `thenRn` \ read_result ->
    case read_result of {
        Left err ->     -- Not found, so add an empty export env to the Ifaces map
                        -- so that we don't look again
@@ -232,7 +242,6 @@ tryLoadInterface doc_str mod_name from
                              iRules      = new_rules,
                              iImpModInfo = mod_map2  }
     in
-    seq mod_map2 $
     setIfacesRn new_ifaces             `thenRn_`
     returnRn (mod_iface, Nothing)
     }}
@@ -467,18 +476,26 @@ new_top_bndrs mod names_w_locs
 findAndReadIface :: SDoc -> ModuleName 
                 -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                        -- False <=> Look for .hi file
+                -> Bool                -- True <=> can read home interface
                 -> RnM d (Either Message (Module, ParsedIface))
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
 
-findAndReadIface doc_str mod_name hi_boot_file
+findAndReadIface doc_str mod_name hi_boot_file home_allowed
   = traceRn trace_msg                  `thenRn_`
 
     ioToRnM (findModule mod_name)      `thenRn` \ maybe_found ->
     case maybe_found of
 
       Right (Just (wanted_mod,locn))
-        -> mkHiPath hi_boot_file locn `thenRn` \ file -> 
+        -> -- in CmdLineMode, we cannot demand-load home interfaces
+          -- because the corresponding code won't be loaded, so we
+          -- check for this here and emit an error message.
+          if (home_allowed && isHomeModule wanted_mod)
+             then returnRn (Left (notLoaded wanted_mod))
+             else
+
+          mkHiPath hi_boot_file locn `thenRn` \ file -> 
           readIface file `thenRn` \ read_result ->
           case read_result of
                 Left bad -> returnRn (Left bad)
@@ -505,9 +522,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 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.
@@ -526,13 +544,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#,
@@ -619,6 +632,9 @@ warnRedundantSourceImport mod_name
   = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
           <+> quotes (ppr mod_name)
 
+notLoaded mod
+  = ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is not loaded")
+
 warnSelfImport mod
   = ptext SLIT("Importing my own interface: module") <+> ppr mod
 \end{code}