projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1999-06-01 16:40:41 by simonmar]
[ghc-hetmet.git] / ghc / compiler / rename / RnIfaces.lhs
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 453fda3..deff6b7 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -1,70 +1,77 @@
 %
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
 
 \begin{code}
 %
 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
 
 \begin{code}
-#include "HsVersions.h"
-
 module RnIfaces (
 module RnIfaces (
-       getInterfaceExports,
-       getImportedInstDecls,
-       getSpecialInstModules,
+       getInterfaceExports, 
+       getImportedInstDecls, getImportedRules,
+       lookupFixity, loadHomeInterface,
        importDecl, recordSlurp,
        importDecl, recordSlurp,
-       getImportVersions, 
+       getImportVersions, getSlurped,
 
        checkUpToDate,
 
 
        checkUpToDate,
 
-       getDeclBinders,
-       mkSearchPath
+       getDeclBinders
     ) where
 
     ) where
 
-IMP_Ubiq()
-
+#include "HsVersions.h"
 
 
-import CmdLineOpts     ( opt_HiSuffix, opt_HiSuffixPrelude )
-import HsSyn           ( HsDecl(..), TyDecl(..), ClassDecl(..), HsTyVar, Bind, HsExpr, Sig(..), HsType(..),
-                         HsBinds(..), MonoBinds, DefaultDecl, ConDecl(..), BangType, IfaceSig(..),
-                         FixityDecl(..), Fixity, Fake, InPat, InstDecl(..), SYN_IE(Version), HsIdInfo,
-                         IE(..)
+import CmdLineOpts     ( opt_NoPruneDecls, opt_IgnoreIfacePragmas )
+import HsSyn           ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
+                         HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
+                         FixitySig(..), RuleDecl(..),
+                         isClassOpSig
                        )
                        )
-import HsPragmas       ( noGenPragmas )
-import RdrHsSyn                ( SYN_IE(RdrNameHsDecl), SYN_IE(RdrNameInstDecl), 
-                         RdrName, rdrNameOcc
+import BasicTypes      ( Version, NewOrData(..), defaultFixity )
+import RdrHsSyn                ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl, RdrNameRuleDecl,
+                         extractHsTyRdrNames
                        )
                        )
-import RnEnv           ( newGlobalName, lookupRn, addImplicitOccsRn, 
-                         availName, availNames, addAvailToNameSet, pprAvail
+import RnEnv           ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdrName,
+                         lookupOccRn,
+                         pprAvail,
+                         availName, availNames, addAvailToNameSet,
+                         FreeVars, emptyFVs
                        )
                        )
-import RnSource                ( rnHsType )
 import RnMonad
 import RnMonad
-import ParseIface      ( parseIface )
-
-import ErrUtils                ( SYN_IE(Error), SYN_IE(Warning) )
-import FiniteMap       ( FiniteMap, emptyFM, unitFM, lookupFM, addToFM, addToFM_C, addListToFM, fmToList )
-import Name            ( Name {-instance NamedThing-}, Provenance, OccName(..),
-                         modAndOcc, occNameString, moduleString, pprModule,
-                         NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
-                         minusNameSet, mkNameSet, elemNameSet,
-                         isWiredInName, maybeWiredInTyConName, maybeWiredInIdName
+import RnHsSyn          ( RenamedHsDecl )
+import ParseIface      ( parseIface, IfaceStuff(..) )
+
+import FiniteMap       ( FiniteMap, sizeFM, emptyFM, delFromFM,
+                         lookupFM, addToFM, addToFM_C, addListToFM, 
+                         fmToList, elemFM, foldFM
+                       )
+import Name            ( Name {-instance NamedThing-},
+                         nameModule, isLocallyDefined,
+                         isWiredInName, nameUnique, NamedThing(..)
                         )
                         )
-import Id              ( GenId, Id(..), idType, dataConTyCon, isDataCon )
-import TyCon           ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
-import Type            ( namesOfType )
-import TyVar           ( GenTyVar )
-import SrcLoc          ( mkIfaceSrcLoc )
-import PrelMods                ( gHC__, isPreludeModule )
+import Module          ( Module, moduleString, pprModule,
+                         mkVanillaModule, pprModuleName,
+                         moduleUserString, moduleName, isLibModule,
+                         ModuleName, WhereFrom(..),
+                       )
+import RdrName         ( RdrName, rdrNameOcc )
+import NameSet
+import Var             ( Id )
+import SrcLoc          ( mkSrcLoc, SrcLoc )
+import PrelMods                ( pREL_GHC )
+import PrelInfo                ( cCallishTyKeys, thinAirModules )
 import Bag
 import Bag
-import Maybes          ( MaybeErr(..), expectJust, maybeToBool )
+import Maybes          ( MaybeErr(..), maybeToBool, orElse )
 import ListSetOps      ( unionLists )
 import ListSetOps      ( unionLists )
-import Pretty
-import PprStyle                ( PprStyle(..) )
-import Util            ( pprPanic, pprTrace )
-import StringBuffer     ( StringBuffer, hGetStringBuffer, freeStringBuffer )
-
+import Outputable
+import Unique          ( Unique )
+import StringBuffer     ( StringBuffer, hGetStringBuffer )
+import FastString      ( mkFastString )
+import Lex
+import Outputable
+
+import IO      ( isDoesNotExistError )
+import List    ( nub )
 \end{code}
 
 
 \end{code}
 
 
-
 %*********************************************************
 %*                                                     *
 \subsection{Loading a new interface file}
 %*********************************************************
 %*                                                     *
 \subsection{Loading a new interface file}
@@ -72,93 +79,208 @@ import StringBuffer     ( StringBuffer, hGetStringBuffer, freeStringBuffer )
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-loadInterface :: Pretty -> Module -> RnMG Ifaces
-loadInterface doc_str load_mod 
-  = getIfacesRn                `thenRn` \ ifaces ->
-    let
-       Ifaces this_mod mod_vers_map export_envs decls all_names imp_names insts inst_mods = ifaces
-    in
+loadHomeInterface :: SDoc -> Name -> RnM d (Module, Ifaces)
+loadHomeInterface doc_str name
+  = loadInterface doc_str (moduleName (nameModule name)) 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
+       in_map   = maybeToBool mod_info
+   in
+
+       -- Issue a warning for a redundant {- SOURCE -} import
+       -- It's redundant if the moduld is in the iImpModInfo at all,
+       -- because we arrange to read all the ordinary imports before 
+       -- any of the {- SOURCE -} imports
+   warnCheckRn (not (in_map && case from of {ImportByUserSource -> True; other -> False}))
+               (warnRedundantSourceImport mod_name)    `thenRn_`
+
        -- CHECK WHETHER WE HAVE IT ALREADY
        -- CHECK WHETHER WE HAVE IT ALREADY
-    if maybeToBool (lookupFM export_envs load_mod) 
-    then
-       returnRn ifaces         -- Already in the cache; don't re-read it
-    else
+   case mod_info of {
+       Just (_, _, Just (load_mod, _, _))
+               ->      -- We're read it already so don't re-read it
+                   returnRn (load_mod, ifaces) ;
+
+       mod_map_result ->
 
        -- READ THE MODULE IN
 
        -- READ THE MODULE IN
-    findAndReadIface doc_str load_mod          `thenRn` \ read_result ->
-    case read_result of {
-       -- Check for not found
+   findAndReadIface doc_str mod_name from in_map       `thenRn` \ (hi_boot_read, 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
        Nothing ->      -- Not found, so add an empty export env to the Ifaces map
                        -- so that we don't look again
                   let
-                       new_export_envs = addToFM export_envs load_mod ([],[])
-                       new_ifaces = Ifaces this_mod mod_vers_map
-                                           new_export_envs
-                                           decls all_names imp_names insts inst_mods
+                       mod         = mkVanillaModule mod_name
+                       new_mod_map = addToFM mod_map mod_name (0, False, Just (mod, False, []))
+                       new_ifaces  = ifaces { iImpModInfo = new_mod_map }
                   in
                   setIfacesRn new_ifaces               `thenRn_`
                   in
                   setIfacesRn new_ifaces               `thenRn_`
-                  failWithRn new_ifaces (noIfaceErr load_mod) ;
+                  failWithRn (mod, new_ifaces) (noIfaceErr mod hi_boot_read) ;
 
        -- Found and parsed!
 
        -- Found and parsed!
-       Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
+       Just (mod, iface) ->
 
        -- LOAD IT INTO Ifaces
 
        -- LOAD IT INTO Ifaces
-    mapRn loadExport exports                           `thenRn` \ avails_s ->
-    foldlRn (loadDecl load_mod) decls rd_decls         `thenRn` \ new_decls ->
-    foldlRn (loadInstDecl load_mod) insts rd_insts     `thenRn` \ new_insts ->
+
+       -- 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
+    in
+    foldlRn (loadDecl mod)          (iDecls ifaces) rd_decls           `thenRn` \ new_decls ->
+    foldlRn (loadInstDecl mod)      (iInsts ifaces) (pi_insts iface)   `thenRn` \ new_insts ->
+    foldlRn (loadRule mod)          (iRules ifaces) (pi_rules iface)   `thenRn` \ new_rules -> 
+    foldlRn (loadFixDecl mod_name)   (iFixes ifaces) rd_decls                  `thenRn` \ new_fixities ->
+    mapRn   (loadExport this_mod_nm) (pi_exports iface)                        `thenRn` \ avails_s ->
     let
     let
-        export_env = (concat avails_s, fixs)
-
-                       -- Exclude this module from the "special-inst" modules
-        new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)
-
-        new_ifaces = Ifaces this_mod
-                            (addToFM mod_vers_map load_mod mod_vers)
-                            (addToFM export_envs load_mod export_env)
-                            new_decls
-                            all_names imp_names
-                            new_insts
-                            new_inst_mods 
+       -- 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 mod_map (pi_usages iface)
+                       other        -> mod_map
+
+       -- Now add info about this module
+       mod_map2    = addToFM mod_map1 mod_name mod_details
+       mod_details = (pi_mod iface, pi_orphan iface, Just (mod, hi_boot_read, concat avails_s))
+
+       new_ifaces = ifaces { iImpModInfo = mod_map2,
+                             iDecls      = new_decls,
+                             iFixes      = new_fixities,
+                             iRules      = new_rules,
+                             iInsts      = new_insts }
     in
     setIfacesRn new_ifaces             `thenRn_`
     in
     setIfacesRn new_ifaces             `thenRn_`
-    returnRn new_ifaces
-    }
+    returnRn (mod, new_ifaces)
+    }}
 
 
-loadExport :: ExportItem -> RnMG [AvailInfo]
-loadExport (mod, entities)
-  = mapRn load_entity entities
+addModDeps :: Module -> ImportedModuleInfo
+          -> [ImportVersion a] -> ImportedModuleInfo
+addModDeps mod mod_deps new_deps
+  = foldr add mod_deps new_deps
   where
   where
-    new_name occ = newGlobalName mod occ
+    is_lib = isLibModule mod   -- Don't record dependencies when importing a library module
+    add (imp_mod, version, has_orphans, _) deps
+       | is_lib && not has_orphans = deps
+       | otherwise                 = addToFM_C combine deps imp_mod (version, has_orphans, Nothing)
+       -- Record dependencies for modules that are
+       --      either are dependent via a non-library module
+       --      or contain orphan rules or instance decls
+
+       -- Don't ditch a module that's already loaded!!
+    combine old@(_, _, Just _)  new = old
+    combine old@(_, _, Nothing) new = new
+
+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!
 
 
--- The communcation between this little code fragment and the "entity" rule
--- in ParseIface.y is a bit gruesome.  The idea is that things which are
--- destined to be AvailTCs show up as (occ, [non-empty-list]), whereas
--- things destined to be Avails show up as (occ, [])
+  | 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
 
 
-    load_entity (occ, occs)
-      =        new_name occ            `thenRn` \ name ->
-       if null occs then
-               returnRn (Avail name)
-       else
-               mapRn new_name occs     `thenRn` \ names ->
-               returnRn (AvailTC name names)
+       -- Ignore the other sorts of decl
+loadFixDecl mod_name fixity_env other_decl = returnRn fixity_env
 
 
-loadDecl :: Module -> DeclsMap
+loadDecl :: Module 
+        -> DeclsMap
         -> (Version, RdrNameHsDecl)
         -> (Version, RdrNameHsDecl)
-        -> RnMG DeclsMap
+        -> RnM d DeclsMap
+
 loadDecl mod decls_map (version, decl)
 loadDecl mod decls_map (version, decl)
-  = getDeclBinders new_implicit_name decl      `thenRn` \ avail ->
-    returnRn (addListToFM decls_map
-                         [(name,(version,avail,decl)) | name <- availNames avail]
-    )
+  = getDeclBinders new_name decl       `thenRn` \ maybe_avail ->
+    case maybe_avail of {
+       Nothing -> returnRn decls_map;  -- No bindings
+       Just avail ->
+
+    getDeclSysBinders new_name decl    `thenRn` \ sys_bndrs ->
+    let
+       main_name     = availName avail
+       new_decls_map = foldl add_decl decls_map
+                                      [ (name, (version, avail, name==main_name, (mod, decl'))) 
+                                      | name <- sys_bndrs ++ availNames avail]
+       add_decl decls_map (name, stuff)
+         = WARN( name `elemNameEnv` decls_map, ppr name )
+           addToNameEnv decls_map name stuff
+    in
+    returnRn new_decls_map
+    }
   where
   where
-    new_implicit_name rdr_name loc = newGlobalName mod (rdrNameOcc rdr_name)
+       -- newImportedBinder puts into the cache the binder with the
+       -- module information set correctly.  When the decl is later renamed,
+       -- the binding site will thereby get the correct module.
+    new_name rdr_name loc = newImportedBinder mod rdr_name
+
+    {-
+      If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
+      we toss away unfolding information.
+
+      Also, if the signature is loaded from a module we're importing from source,
+      we do the same. This is to avoid situations when compiling a pair of mutually
+      recursive modules, peering at unfolding info in the interface file of the other, 
+      e.g., you compile A, it looks at B's interface file and may as a result change
+      its interface file. Hence, B is recompiled, maybe changing its interface file,
+      which will the unfolding info used in A to become invalid. Simple way out is to
+      just ignore unfolding info.
+
+      [Jan 99: I junked the second test above.  If we're importing from an hi-boot
+       file there isn't going to *be* any pragma info.  Maybe the above comment
+       dates from a time where we picked up a .hi file first if it existed?]
+    -}
+    decl' = case decl of
+              SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas ->  SigD (IfaceSig name tp [] loc)
+              other                                                   -> decl
 
 loadInstDecl :: Module
 
 loadInstDecl :: Module
-            -> Bag IfaceInst
+            -> Bag GatedDecl
             -> RdrNameInstDecl
             -> RdrNameInstDecl
-            -> RnMG (Bag IfaceInst)
-loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
+            -> RnM d (Bag GatedDecl)
+loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
   = 
        -- Find out what type constructors and classes are "gates" for the
        -- instance declaration.  If all these "gates" are slurped in then
   = 
        -- Find out what type constructors and classes are "gates" for the
        -- instance declaration.  If all these "gates" are slurped in then
@@ -170,17 +292,33 @@ loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_lo
        --
        -- Here the gates are Baz and T, but *not* Foo.
     let 
        --
        -- Here the gates are Baz and T, but *not* Foo.
     let 
-       munged_inst_ty = case inst_ty of
-                               HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
-                               HsPreForAllTy cxt ty  -> HsPreForAllTy [] ty
-                               other                 -> inst_ty
+       munged_inst_ty = removeContext inst_ty
+       free_names     = extractHsTyRdrNames munged_inst_ty
     in
     in
-       -- We find the gates by renaming the instance type with in a 
-       -- and returning the occurrence pool.
-    initRnMS emptyRnEnv mod_name InterfaceMode (
-        findOccurrencesRn (rnHsType munged_inst_ty)    
-    )                                          `thenRn` \ gate_names ->
-    returnRn (((mod_name, decl), gate_names) `consBag` insts)
+    setModuleRn (moduleName mod) $
+    mapRn mkImportedGlobalFromRdrName free_names       `thenRn` \ gate_names ->
+    returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)
+
+
+-- In interface files, the instance decls now look like
+--     forall a. Foo a -> Baz (T a)
+-- so we have to strip off function argument types as well
+-- as the bit before the '=>' (which is always empty in interface files)
+removeContext (HsForAllTy tvs cxt ty) = HsForAllTy tvs [] (removeFuns ty)
+removeContext ty                     = removeFuns ty
+
+removeFuns (MonoFunTy _ ty) = removeFuns ty
+removeFuns ty              = ty
+
+
+loadRule :: Module -> Bag GatedDecl 
+        -> RdrNameRuleDecl -> RnM d (Bag GatedDecl)
+-- "Gate" the rule simply by whether the rule variable is
+-- needed.  We can refine this later.
+loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
+  = setModuleRn (moduleName mod) $
+    mkImportedGlobalFromRdrName var            `thenRn` \ var_name ->
+    returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
 \end{code}
 
 
 \end{code}
 
 
@@ -191,75 +329,94 @@ loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_lo
 %********************************************************
 
 \begin{code}
 %********************************************************
 
 \begin{code}
-checkUpToDate :: Module -> RnMG Bool           -- True <=> no need to recompile
+checkUpToDate :: ModuleName -> RnMG Bool               -- True <=> no need to recompile
 checkUpToDate mod_name
 checkUpToDate mod_name
-  = findAndReadIface doc_str mod_name          `thenRn` \ read_result ->
+  = getIfacesRn                                        `thenRn` \ ifaces ->
+    findAndReadIface doc_str mod_name 
+                    ImportByUser
+                    (error "checkUpToDate")    `thenRn` \ (_, read_result) ->
+
+       -- CHECK WHETHER WE HAVE IT ALREADY
     case read_result of
        Nothing ->      -- Old interface file not found, so we'd better bail out
     case read_result of
        Nothing ->      -- Old interface file not found, so we'd better bail out
-                   traceRn (ppSep [ppPStr SLIT("Didnt find old iface"), 
-                                   pprModule PprDebug mod_name])       `thenRn_`
+                   traceRn (sep [ptext SLIT("Didnt find old iface"), 
+                                 pprModuleName mod_name])      `thenRn_`
                    returnRn False
 
                    returnRn False
 
-       Just (ParsedIface _ _ usages _ _ _ _ _) 
+       Just (_, iface)
                ->      -- Found it, so now check it
                ->      -- Found it, so now check it
-                   checkModUsage usages
+                   checkModUsage (pi_usages iface)
   where
        -- Only look in current directory, with suffix .hi
   where
        -- Only look in current directory, with suffix .hi
-    doc_str = ppSep [ppPStr SLIT("Need usage info from"), pprModule PprDebug mod_name]
-
+    doc_str = sep [ptext SLIT("need usage info from"), pprModuleName mod_name]
 
 checkModUsage [] = returnRn True               -- Yes!  Everything is up to date!
 
 
 checkModUsage [] = returnRn True               -- Yes!  Everything is up to date!
 
-checkModUsage ((mod, old_mod_vers, old_local_vers) : rest)
-  = loadInterface doc_str mod          `thenRn` \ ifaces ->
+checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
+  = loadInterface doc_str mod_name ImportBySystem      `thenRn` \ (mod, ifaces) ->
     let
     let
-       Ifaces _ mod_vers _ decls _ _ _ _ = ifaces
-       maybe_new_mod_vers = lookupFM mod_vers mod
-       Just new_mod_vers  = maybe_new_mod_vers
+       maybe_mod_vers = case lookupFM (iImpModInfo ifaces) mod_name of
+                          Just (version, _, Just (_, _, _)) -> Just version
+                          other                             -> Nothing
     in
     in
-       -- If we can't find a version number for the old module then
-       -- bail out saying things aren't up to date
-    if not (maybeToBool maybe_new_mod_vers) then
-       returnRn False
-    else
+    case maybe_mod_vers of {
+       Nothing ->      -- If we can't find a version number for the old module then
+                       -- bail out saying things aren't up to date
+               traceRn (sep [ptext SLIT("Can't find version number for module"), 
+                             pprModuleName mod_name])                          `thenRn_`
+               returnRn False ;
+
+       Just new_mod_vers ->
 
        -- If the module version hasn't changed, just move on
     if new_mod_vers == old_mod_vers then
 
        -- If the module version hasn't changed, just move on
     if new_mod_vers == old_mod_vers then
-       traceRn (ppSep [ppPStr SLIT("Module version unchanged:"), pprModule PprDebug mod])      `thenRn_`
+       traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name]) `thenRn_`
        checkModUsage rest
     else
        checkModUsage rest
     else
-    traceRn (ppSep [ppPStr SLIT("Module version has changed:"), pprModule PprDebug mod])       `thenRn_`
+    traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name])  `thenRn_`
+
+       -- Module version changed, so check entities inside
+
+       -- If the usage info wants to say "I imported everything from this module"
+       --     it does so by making whats_imported equal to Everything
+       -- In that case, we must recompile
+    case whats_imported of {
+      Everything -> traceRn (ptext SLIT("...and I needed the whole module"))   `thenRn_`
+                   returnRn False;                -- Bale out
 
 
-       -- New module version, so check entities inside
-    checkEntityUsage mod decls old_local_vers  `thenRn` \ up_to_date ->
+      Specifically old_local_vers ->
+
+       -- Non-empty usage list, so check item by item
+    checkEntityUsage mod_name (iDecls ifaces) old_local_vers   `thenRn` \ up_to_date ->
     if up_to_date then
     if up_to_date then
-       traceRn (ppPStr SLIT("...but the bits I use haven't.")) `thenRn_`
+       traceRn (ptext SLIT("...but the bits I use haven't."))  `thenRn_`
        checkModUsage rest      -- This one's ok, so check the rest
     else
        returnRn False          -- This one failed, so just bail out now
        checkModUsage rest      -- This one's ok, so check the rest
     else
        returnRn False          -- This one failed, so just bail out now
+    }}
   where
   where
-    doc_str = ppSep [ppPStr SLIT("need version info for"), pprModule PprDebug mod]
+    doc_str = sep [ptext SLIT("need version info for"), pprModuleName mod_name]
 
 
 checkEntityUsage mod decls [] 
   = returnRn True      -- Yes!  All up to date!
 
 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 
 
 checkEntityUsage mod decls [] 
   = returnRn True      -- Yes!  All up to date!
 
 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
-  = newGlobalName mod occ_name         `thenRn` \ name ->
-    case lookupFM decls name of
+  = mkImportedGlobalName mod occ_name  `thenRn` \ name ->
+    case lookupNameEnv decls name of
 
        Nothing       ->        -- We used it before, but it ain't there now
 
        Nothing       ->        -- We used it before, but it ain't there now
-                         traceRn (ppSep [ppPStr SLIT("...and this no longer exported:"), ppr PprDebug name])   `thenRn_`
+                         putDocRn (sep [ptext SLIT("No longer exported:"), ppr name])  `thenRn_`
                          returnRn False
 
                          returnRn False
 
-       Just (new_vers,_,_)     -- It's there, but is it up to date?
+       Just (new_vers,_,_,_)   -- It's there, but is it up to date?
                | new_vers == old_vers
                        -- Up to date, so check the rest
                -> checkEntityUsage mod decls rest
 
                | otherwise
                        -- Out of date, so bale out
                | new_vers == old_vers
                        -- Up to date, so check the rest
                -> checkEntityUsage mod decls rest
 
                | otherwise
                        -- Out of date, so bale out
-               -> traceRn (ppSep [ppPStr SLIT("...and this is out of date:"), ppr PprDebug name])  `thenRn_`
+               -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
                   returnRn False
 \end{code}
 
                   returnRn False
 \end{code}
 
@@ -271,51 +428,48 @@ checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-importDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
-       -- Returns Nothing for a wired-in or already-slurped decl
-
-importDecl name necessity
-  = checkSlurped name                  `thenRn` \ already_slurped ->
-    if already_slurped then
-       -- traceRn (ppSep [ppStr "Already slurped:", ppr PprDebug name])        `thenRn_`
+importDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
+       -- Returns Nothing for 
+       --      (a) wired in name
+       --      (b) local decl
+       --      (c) already slurped
+
+importDecl name
+  | isWiredInName name
+  = returnRn Nothing
+  | otherwise
+  = getSlurped                                 `thenRn` \ already_slurped ->
+    if name `elemNameSet` already_slurped then
        returnRn Nothing        -- Already dealt with
     else
        returnRn Nothing        -- Already dealt with
     else
-    if isWiredInName name then
-       getWiredInDecl name
-    else 
-       getIfacesRn             `thenRn` \ ifaces ->
-       let
-         Ifaces this_mod _ _ _ _ _ _ _ = ifaces
-         (mod,_) = modAndOcc name
-       in
-       if mod == this_mod  then    -- Don't bring in decls from
-         pprTrace "importDecl wierdness:" (ppr PprDebug name) $
-         returnRn Nothing         -- the renamed module's own interface file
-                                  -- 
-       else
-       getNonWiredInDecl name necessity
-
+       getModuleRn             `thenRn` \ this_mod ->
+       let
+         mod = moduleName (nameModule name)
+       in
+       if mod == this_mod then         -- Don't bring in decls from
+                                       -- the renamed module's own interface file
+                 addWarnRn (importDeclWarn mod name) `thenRn_`
+                 returnRn Nothing
+       else
+       getNonWiredInDecl name
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-getNonWiredInDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
-getNonWiredInDecl name necessity
-  = traceRn doc_str                    `thenRn_`
-    loadInterface doc_str mod          `thenRn` \ (Ifaces _ _ _ decls _ _ _ _) ->
-    case lookupFM decls name of
-
-      Just (version,avail,decl) -> recordSlurp (Just version) avail    `thenRn_`
-                                  returnRn (Just decl)
-
-      Nothing ->       -- Can happen legitimately for "Optional" occurrences
-                  case necessity of { 
-                               Optional -> addWarnRn (getDeclWarn name);
-                               other    -> addErrRn  (getDeclErr  name)
-                  }                                            `thenRn_` 
-                  returnRn Nothing
+getNonWiredInDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
+getNonWiredInDecl needed_name 
+  = traceRn doc_str                            `thenRn_`
+    loadHomeInterface doc_str needed_name      `thenRn` \ (_, ifaces) ->
+    case lookupNameEnv (iDecls ifaces) needed_name of
+
+      Just (version,avail,_,decl)
+       -> recordSlurp (Just version) avail     `thenRn_`
+          returnRn (Just decl)
+
+      Nothing          -- Can happen legitimately for "Optional" occurrences
+       -> addErrRn (getDeclErr needed_name)    `thenRn_` 
+          returnRn Nothing
   where
   where
-     doc_str = ppSep [ppPStr SLIT("Need decl for"), ppr PprDebug name]
-     (mod,_) = modAndOcc name
+     doc_str = ptext SLIT("need decl for") <+> ppr needed_name
 \end{code}
 
 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
 \end{code}
 
 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
@@ -337,184 +491,118 @@ Specifically,
 All this is necessary so that we know all types that are "in play", so
 that we know just what instances to bring into scope.
        
 All this is necessary so that we know all types that are "in play", so
 that we know just what instances to bring into scope.
        
-\begin{code}
-getWiredInDecl name
-  = get_wired                          `thenRn` \ avail ->
-    recordSlurp Nothing avail          `thenRn_`
-
-       -- Force in the home module in case it has instance decls for
-       -- the thing we are interested in.
-       --
-       -- Mini hack 1: no point for non-tycons/class; and if we
-       -- do this we find PrelNum trying to import PackedString,
-       -- because PrelBase's .hi file mentions PackedString.unpackString
-       -- But PackedString.hi isn't built by that point!
-       --
-       -- Mini hack 2; GHC is guaranteed not to have
-       -- instance decls, so it's a waste of time to read it
-       --
-       -- NB: We *must* look at the availName of the slurped avail, 
-       -- not the name passed to getWiredInDecl!  Why?  Because if a data constructor 
-       -- or class op is passed to getWiredInDecl we'll pull in the whole data/class
-       -- decl, and recordSlurp will record that fact.  But since the data constructor
-       -- isn't a tycon/class we won't force in the home module.  And even if the
-       -- type constructor/class comes along later, loadDecl will say that it's already
-       -- been slurped, so getWiredInDecl won't even be called.  Pretty obscure bug, this was.
-    let
-       main_name  = availName avail
-       main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
-       (mod,_)    = modAndOcc main_name
-       doc_str    = ppSep [ppPStr SLIT("Need home module for wired in thing"), ppr PprDebug name]
-    in
-    (if not main_is_tc || mod == gHC__ then
-       returnRn ()             
-    else
-       loadInterface doc_str mod       `thenRn_`
-       returnRn ()
-    )                                  `thenRn_`
 
 
-    returnRn Nothing           -- No declaration to process further
-  where
-
-    get_wired | is_tycon                       -- ... a type constructor
-             = get_wired_tycon the_tycon
-
-             | (isDataCon the_id)              -- ... a wired-in data constructor
-             = get_wired_tycon (dataConTyCon the_id)
-
-             | otherwise                       -- ... a wired-in non data-constructor
-             = get_wired_id the_id
-
-    maybe_wired_in_tycon = maybeWiredInTyConName name
-    is_tycon            = maybeToBool maybe_wired_in_tycon
-    maybe_wired_in_id    = maybeWiredInIdName    name
-    Just the_tycon      = maybe_wired_in_tycon
-    Just the_id         = maybe_wired_in_id
-
-
-get_wired_id id
-  = addImplicitOccsRn (nameSetToList id_mentioned)     `thenRn_`
-    returnRn (Avail (getName id))
-  where
-    id_mentioned = namesOfType (idType id)
-
-get_wired_tycon tycon 
-  | isSynTyCon tycon
-  = addImplicitOccsRn (nameSetToList mentioned)                `thenRn_`
-    returnRn (Avail (getName tycon))
-  where
-    (tyvars,ty) = getSynTyConDefn tycon
-    mentioned = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
 
 
-get_wired_tycon tycon 
-  | otherwise          -- data or newtype
-  = addImplicitOccsRn (nameSetToList mentioned)                `thenRn_`
-    returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
-  where
-    tycon_name = getName tycon
-    data_cons  = tyConDataCons tycon
-    mentioned  = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
-\end{code}
-
-
-\begin{code}
-checkSlurped name
-  = getIfacesRn        `thenRn` \ (Ifaces _ _ _ _ slurped_names _ _ _) ->
-    returnRn (name `elemNameSet` slurped_names)
-
-recordSlurp maybe_version avail
-  = -- traceRn (ppSep [ppStr "Record slurp:", pprAvail PprDebug avail])        `thenRn_`
-    getIfacesRn        `thenRn` \ ifaces ->
-    let
-       Ifaces this_mod mod_vers export_envs decls slurped_names imp_names insts inst_mods = ifaces
-       new_slurped_names = addAvailToNameSet slurped_names avail
-
-       new_imp_names = case maybe_version of
-                          Just version -> (availName avail, version) : imp_names
-                          Nothing      -> imp_names
-
-       new_ifaces = Ifaces this_mod mod_vers export_envs decls 
-                           new_slurped_names 
-                           new_imp_names
-                           insts
-                           inst_mods
-    in
-    setIfacesRn new_ifaces
-\end{code}
     
 %*********************************************************
 %*                                                     *
     
 %*********************************************************
 %*                                                     *
-\subsection{Getting other stuff}
+\subsection{Getting what a module exports}
 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 
+@getInterfaceExports@ is called only for directly-imported modules
+
 \begin{code}
 \begin{code}
-getInterfaceExports :: Module -> RnMG (Avails, [(OccName,Fixity)])
-getInterfaceExports mod
-  = loadInterface doc_str mod          `thenRn` \ (Ifaces _ _ export_envs _ _ _ _ _) ->
-    case lookupFM export_envs mod of
+getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
+getInterfaceExports mod_name from
+  = loadInterface doc_str mod_name from        `thenRn` \ (mod, ifaces) ->
+    case lookupFM (iImpModInfo ifaces) mod_name 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.)
        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 stuff -> returnRn stuff
+       Just (_, _, Just (mod, _, avails)) -> returnRn (mod, avails)
   where
   where
-    doc_str = ppSep [pprModule PprDebug mod, ppPStr SLIT("is directly imported")]
+    doc_str = sep [pprModuleName mod_name, ptext SLIT("is directly imported")]
+\end{code}
 
 
 
 
-getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
-getImportedInstDecls
-  =    -- First load any special-instance modules that aren't aready loaded
-    getSpecialInstModules                      `thenRn` \ inst_mods ->
-    mapRn load_it inst_mods                    `thenRn_`
+%*********************************************************
+%*                                                     *
+\subsection{Instance declarations are handled specially}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
+getImportedInstDecls gates
+  =    -- First load any orphan-instance modules that aren't aready loaded
+       -- Orphan-instance modules are recorded in the module dependecnies
+    getIfacesRn                                                `thenRn` \ ifaces ->
+    let
+       orphan_mods = [mod | (mod, (_, True, Nothing)) <- fmToList (iImpModInfo ifaces)]
+    in
+    traceRn (text "Loading orphan modules" <+> fsep (map pprModuleName orphan_mods))   `thenRn_`
+    mapRn_ load_it orphan_mods         `thenRn_`
 
        -- Now we're ready to grab the instance declarations
        -- Find the un-gated ones and return them, 
        -- removing them from the bag kept in Ifaces
 
        -- Now we're ready to grab the instance declarations
        -- Find the un-gated ones and return them, 
        -- removing them from the bag kept in Ifaces
-    getIfacesRn        `thenRn` \ ifaces ->
+    getIfacesRn                                                `thenRn` \ ifaces ->
     let
     let
-       Ifaces this_mod mod_vers export_envs decls slurped_names imp_names insts inst_mods = ifaces
-
-               -- An instance decl is ungated if all its gates have been slurped
-        select_ungated :: IfaceInst                                    -- A gated inst decl
-
-                      -> ([(Module, RdrNameInstDecl)], [IfaceInst])    -- Accumulator
-
-                      -> ([(Module, RdrNameInstDecl)],                 -- The ungated ones
-                          [IfaceInst])                                 -- Still gated, but with
-                                                                       -- depeleted gates
-       select_ungated (decl,gates) (ungated_decls, gated_decls)
-         | null remaining_gates
-         = (decl : ungated_decls, gated_decls)
-         | otherwise
-         = (ungated_decls, (decl, remaining_gates) : gated_decls)
-         where
-           remaining_gates = filter (not . (`elemNameSet` slurped_names)) gates
-
-       (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
-       
-       new_ifaces = Ifaces this_mod mod_vers export_envs decls slurped_names imp_names
-                           (listToBag still_gated_insts)
-                           inst_mods
+       (decls, new_insts) = selectGated gates (iInsts ifaces)
     in
     in
-    setIfacesRn new_ifaces     `thenRn_`
-    returnRn un_gated_insts
-  where
-    load_it mod = loadInterface (doc_str mod) mod
-    doc_str mod = ppSep [pprModule PprDebug mod, ppPStr SLIT("is a special-instance module")]
+    setIfacesRn (ifaces { iInsts = new_insts })                `thenRn_`
 
 
+    traceRn (sep [text "getImportedInstDecls:", 
+                 nest 4 (fsep (map ppr (nameSetToList gates))),
+                 text "Slurped" <+> int (length decls) <+> text "instance declarations"])      `thenRn_`
+    returnRn decls
+  where
+    load_it mod = loadInterface (doc_str mod) mod ImportBySystem
+    doc_str mod = sep [pprModuleName mod, ptext SLIT("is a orphan-instance module")]
 
 
-getSpecialInstModules :: RnMG [Module]
-getSpecialInstModules 
-  = getIfacesRn                                                `thenRn` \ ifaces ->
+getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
+getImportedRules
+  = getIfacesRn        `thenRn` \ ifaces ->
     let
     let
-        Ifaces _ _ _ _ _ _ _ inst_mods = ifaces
+       gates              = iSlurp ifaces      -- Anything at all that's been slurped
+       (decls, new_rules) = selectGated gates (iRules ifaces)
     in
     in
-    returnRn inst_mods
+    setIfacesRn (ifaces { iRules = new_rules })                `thenRn_`
+    traceRn (sep [text "getImportedRules:", 
+                 text "Slurped" <+> int (length decls) <+> text "rules"])      `thenRn_`
+    returnRn decls
+
+selectGated gates decl_bag
+#ifdef DEBUG
+  | opt_NoPruneDecls   -- Just to try the effect of not gating at all
+  = (foldrBag (\ (_,d) ds -> d:ds) [] decl_bag, emptyBag)      -- Grab them all
+
+  | otherwise
+#endif
+  = foldrBag select ([], emptyBag) decl_bag
+  where
+    select (reqd, decl) (yes, no)
+       | isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
+       | otherwise                                  = (yes,      (reqd,decl) `consBag` no)
+
+lookupFixity :: Name -> RnMS Fixity
+lookupFixity name
+  | isLocallyDefined name
+  = getFixityEnv                       `thenRn` \ local_fix_env ->
+    case lookupNameEnv local_fix_env name of 
+       Just (FixitySig _ fix _) -> returnRn fix
+       Nothing                  -> returnRn defaultFixity
+
+  | otherwise  -- Imported
+  = loadHomeInterface doc name         `thenRn` \ (_, ifaces) ->
+    case lookupNameEnv (iFixes ifaces) name of
+       Just (FixitySig _ fix _) -> returnRn fix 
+       Nothing                  -> returnRn defaultFixity
+  where
+    doc = ptext SLIT("Checking fixity for") <+> ppr name
 \end{code}
 
 \end{code}
 
+
+%*********************************************************
+%*                                                     *
+\subsection{Keeping track of what we've slurped, and version numbers}
+%*                                                     *
+%*********************************************************
+
 getImportVersions figures out what the "usage information" for this moudule is;
 that is, what it must record in its interface file as the things it uses.
 It records:
 getImportVersions figures out what the "usage information" for this moudule is;
 that is, what it must record in its interface file as the things it uses.
 It records:
@@ -553,43 +641,77 @@ On the other hand, if A exports "module B" then we *do* count module B among
 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 
 \begin{code}
 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 
 \begin{code}
-getImportVersions :: Module                    -- Name of this module
+getImportVersions :: ModuleName                        -- Name of this module
                  -> Maybe [IE any]             -- Export list for this module
                  -> RnMG (VersionInfo Name)    -- Version info for these names
 
 getImportVersions this_mod exports
   = getIfacesRn                                        `thenRn` \ ifaces ->
     let
                  -> Maybe [IE any]             -- Export list for this module
                  -> RnMG (VersionInfo Name)    -- Version info for these names
 
 getImportVersions this_mod exports
   = getIfacesRn                                        `thenRn` \ ifaces ->
     let
-        Ifaces _ mod_versions_map _ _ _ imp_names _ _ = ifaces
-        mod_version mod = expectJust "import_versions" (lookupFM mod_versions_map mod)
-
-        -- mv_map groups together all the things imported from a particular module.
-        mv_map, mv_map_mod :: FiniteMap Module [LocalVersion Name]
-
-        mv_map_mod = foldl add_mod emptyFM export_mods
-               -- mv_map_mod records all the modules that have a "module M"
-               -- in this module's export list
-
-        mv_map = foldl add_mv mv_map_mod imp_names
-               -- mv_map adds the version numbers of things exported individually
+       mod_map   = iImpModInfo ifaces
+       imp_names = iVSlurp     ifaces
+
+       -- mv_map groups together all the things imported from a particular module.
+       mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
+
+               -- mv_map1 records all the modules that have a "module M"
+               -- in this module's export list with an "Everything" 
+       mv_map1 = foldr add_mod emptyFM export_mods
+
+               -- mv_map2 adds the version numbers of things exported individually
+       mv_map2 = foldr add_mv mv_map1 imp_names
+
+       -- Build the result list by adding info for each module, 
+       -- *omitting*   (a) library modules
+       --              (b) source-imported modules
+       mk_version_info mod_name (version, has_orphans, cts) so_far
+          | omit cts  = so_far -- Don't record usage info for this module
+          | otherwise = (mod_name, version, has_orphans, whats_imported) : so_far
+          where
+            whats_imported = case lookupFM mv_map2 mod_name of
+                               Just wi -> wi
+                               Nothing -> Specifically []
+
+       omit (Just (mod, boot_import, _)) = isLibModule mod || boot_import
+       omit Nothing                      = False
     in
     in
-    returnRn [ (mod, mod_version mod, local_versions)
-            | (mod, local_versions) <- fmToList mv_map
-            ]
-
+    returnRn (foldFM mk_version_info [] mod_map)
   where
      export_mods = case exports of
                        Nothing -> []
                        Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 
   where
      export_mods = case exports of
                        Nothing -> []
                        Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 
-     add_mv mv_map v@(name, version) 
-      = addToFM_C (\ ls _ -> (v:ls)) mv_map mod [v] 
+     add_mv v@(name, version) mv_map
+      = addToFM_C add_item mv_map mod (Specifically [v]) 
        where
        where
-        (mod,_) = modAndOcc name
+        mod = moduleName (nameModule name)
+
+         add_item Everything        _ = Everything
+         add_item (Specifically xs) _ = Specifically (v:xs)
+
+     add_mod mod mv_map = addToFM mv_map mod Everything
+\end{code}
+
+\begin{code}
+getSlurped
+  = getIfacesRn        `thenRn` \ ifaces ->
+    returnRn (iSlurp ifaces)
 
 
-     add_mod mv_map mod = addToFM mv_map mod []
+recordSlurp maybe_version avail
+  = getIfacesRn        `thenRn` \ ifaces@(Ifaces { iSlurp  = slurped_names,
+                                                   iVSlurp = imp_names }) ->
+    let
+       new_slurped_names = addAvailToNameSet slurped_names avail
+
+       new_imp_names = case maybe_version of
+                          Just version -> (availName avail, version) : imp_names
+                          Nothing      -> imp_names
+    in
+    setIfacesRn (ifaces { iSlurp  = new_slurped_names,
+                         iVSlurp = new_imp_names })
 \end{code}
 
 \end{code}
 
+
 %*********************************************************
 %*                                                     *
 \subsection{Getting binders out of a declaration}
 %*********************************************************
 %*                                                     *
 \subsection{Getting binders out of a declaration}
@@ -604,64 +726,85 @@ It doesn't deal with source-code specific things: ValD, DefD.  They
 are handled by the sourc-code specific stuff in RnNames.
 
 \begin{code}
 are handled by the sourc-code specific stuff in RnNames.
 
 \begin{code}
-getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)             -- New-name function
+getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)    -- New-name function
                -> RdrNameHsDecl
                -> RdrNameHsDecl
-               -> RnMG AvailInfo
+               -> RnM d (Maybe AvailInfo)
 
 
-getDeclBinders new_name (TyD (TyData _ tycon _ condecls _ _ src_loc))
+getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
   = new_name tycon src_loc                     `thenRn` \ tycon_name ->
     getConFieldNames new_name condecls         `thenRn` \ sub_names ->
   = new_name tycon src_loc                     `thenRn` \ tycon_name ->
     getConFieldNames new_name condecls         `thenRn` \ sub_names ->
-    returnRn (AvailTC tycon_name (tycon_name : sub_names))
-
-getDeclBinders new_name (TyD (TyNew _ tycon _ (NewConDecl con _ con_loc) _ _ src_loc))
-  = new_name tycon src_loc             `thenRn` \ tycon_name ->
-    new_name con src_loc               `thenRn` \ con_name ->
-    returnRn (AvailTC tycon_name [tycon_name, con_name])
+    returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
+       -- The "nub" is because getConFieldNames can legitimately return duplicates,
+       -- when a record declaration has the same field in multiple constructors
 
 
-getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
+getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
   = new_name tycon src_loc             `thenRn` \ tycon_name ->
   = new_name tycon src_loc             `thenRn` \ tycon_name ->
-    returnRn (Avail tycon_name)
+    returnRn (Just (AvailTC tycon_name [tycon_name]))
 
 
-getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ src_loc))
+getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ _ _ _ src_loc))
   = new_name cname src_loc                     `thenRn` \ class_name ->
   = new_name cname src_loc                     `thenRn` \ class_name ->
-    mapRn (getClassOpNames new_name) sigs      `thenRn` \ sub_names ->
-    returnRn (AvailTC class_name (class_name : sub_names))
+
+       -- Record the names for the class ops
+    let
+       -- just want class-op sigs
+       op_sigs = filter isClassOpSig sigs
+    in
+    mapRn (getClassOpNames new_name) op_sigs   `thenRn` \ sub_names ->
+
+    returnRn (Just (AvailTC class_name (class_name : sub_names)))
 
 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
   = new_name var src_loc                       `thenRn` \ var_name ->
 
 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
   = new_name var src_loc                       `thenRn` \ var_name ->
-    returnRn (Avail var_name)
+    returnRn (Just (Avail var_name))
 
 
-getDeclBinders new_name (DefD _)  = returnRn NotAvailable
-getDeclBinders new_name (InstD _) = returnRn NotAvailable
+getDeclBinders new_name (FixD _)  = returnRn Nothing
+getDeclBinders new_name (ForD _)  = returnRn Nothing
+getDeclBinders new_name (DefD _)  = returnRn Nothing
+getDeclBinders new_name (InstD _) = returnRn Nothing
+getDeclBinders new_name (RuleD _) = returnRn Nothing
 
 ----------------
 
 ----------------
-getConFieldNames new_name (ConDecl con _ src_loc : rest)
-  = new_name con src_loc               `thenRn` \ n ->
-    getConFieldNames new_name rest     `thenRn` \ ns -> 
-    returnRn (n:ns)
-
-getConFieldNames new_name (NewConDecl con _ src_loc : rest)
-  = new_name con src_loc               `thenRn` \ n ->
-    getConFieldNames new_name rest     `thenRn` \ ns -> 
-    returnRn (n:ns)
-
-getConFieldNames new_name (ConOpDecl _ con _ src_loc : rest)
-  = new_name con src_loc               `thenRn` \ n ->
-    getConFieldNames new_name rest     `thenRn` \ ns -> 
-    returnRn (n:ns)
-
-getConFieldNames new_name (RecConDecl con fielddecls src_loc : rest)
+getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
   = mapRn (\n -> new_name n src_loc) (con:fields)      `thenRn` \ cfs ->
     getConFieldNames new_name rest                     `thenRn` \ ns  -> 
     returnRn (cfs ++ ns)
   where
     fields = concat (map fst fielddecls)
 
   = mapRn (\n -> new_name n src_loc) (con:fields)      `thenRn` \ cfs ->
     getConFieldNames new_name rest                     `thenRn` \ ns  -> 
     returnRn (cfs ++ ns)
   where
     fields = concat (map fst fielddecls)
 
+getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
+  = new_name con src_loc               `thenRn` \ n ->
+    (case condecl of
+      NewCon _ (Just f) -> 
+        new_name f src_loc `thenRn` \ new_f ->
+       returnRn [n,new_f]
+      _ -> returnRn [n])               `thenRn` \ nn ->
+    getConFieldNames new_name rest     `thenRn` \ ns -> 
+    returnRn (nn ++ ns)
+
 getConFieldNames new_name [] = returnRn []
 
 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 \end{code}
 
 getConFieldNames new_name [] = returnRn []
 
 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 \end{code}
 
+@getDeclSysBinders@ gets the implicit binders introduced by a decl.
+A the moment that's just the tycon and datacon that come with a class decl.
+They aren'te returned by getDeclBinders because they aren't in scope;
+but they *should* be put into the DeclsMap of this module.
+
+Note that this excludes the default-method names of a class decl,
+and the dict fun of an instance decl, because both of these have 
+bindings of their own elsewhere.
+
+\begin{code}
+getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname snames src_loc))
+  = new_name dname src_loc                             `thenRn` \ datacon_name ->
+    new_name tname src_loc                             `thenRn` \ tycon_name ->
+    sequenceRn [new_name n src_loc | n <- snames]      `thenRn` \ scsel_names ->
+    returnRn (tycon_name : datacon_name : scsel_names)
+
+getDeclSysBinders new_name other_decl
+  = returnRn []
+\end{code}
 
 %*********************************************************
 %*                                                     *
 
 %*********************************************************
 %*                                                     *
@@ -670,95 +813,119 @@ getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-findAndReadIface :: Pretty -> Module -> RnMG (Maybe ParsedIface)
+findAndReadIface :: SDoc -> ModuleName -> WhereFrom 
+                -> Bool        -- Only relevant for SystemImport
+                               -- True  <=> Look for a .hi file
+                               -- False <=> Look for .hi-boot file unless there's
+                               --           a library .hi file
+                -> RnM d (Bool, Maybe (Module, ParsedIface))
+       -- Bool is True if the interface actually read was a .hi-boot one
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
-findAndReadIface doc_str mod
+
+findAndReadIface doc_str mod_name from hi_file
   = traceRn trace_msg                  `thenRn_`
   = traceRn trace_msg                  `thenRn_`
-    getSearchPathRn                    `thenRn` \ dirs ->
-    try dirs dirs
+      -- we keep two maps for interface files,
+      -- one for 'normal' ones, the other for .hi-boot files,
+      -- hence the need to signal which kind we're interested.
+
+    getHiMaps                  `thenRn` \ hi_maps ->
+       
+    case find_path from hi_maps of
+         -- Found the file
+       (hi_boot, Just (fpath, mod)) -> traceRn (ptext SLIT("...reading from") <+> text fpath)  `thenRn_`
+                                      readIface mod fpath      `thenRn` \ result ->
+                                      returnRn (hi_boot, result)
+       (hi_boot, Nothing)           -> traceRn (ptext SLIT("...not found"))    `thenRn_`
+                                      returnRn (hi_boot, Nothing)
   where
   where
-    trace_msg = ppHang (ppBesides [ppPStr SLIT("Reading interface for "), 
-                                  pprModule PprDebug mod, ppSemi])
-                    4 (ppBesides [ppPStr SLIT("reason: "), doc_str])
-
-    mod_str = moduleString mod
-    hisuf =
-      if isPreludeModule mod then
-         case opt_HiSuffixPrelude of { Just hisuf -> hisuf; _ -> ".hi"}
-      else
-         case opt_HiSuffix of {Just hisuf -> hisuf; _ -> ".hi"}
-
-    try all_dirs [] = traceRn (ppPStr SLIT("...failed"))       `thenRn_`
-                     returnRn Nothing
-
-    try all_dirs (dir:dirs)
-       = readIface file_path   `thenRn` \ read_result ->
-         case read_result of
-               Nothing    -> try all_dirs dirs
-               Just iface -> traceRn (ppPStr SLIT("...done"))  `thenRn_`
-                             returnRn (Just iface)
-       where
-         file_path = dir ++ "/" ++ moduleString mod ++ hisuf
+    find_path ImportByUser       (hi_map, _)     = (False, lookupFM hi_map mod_name)
+    find_path ImportByUserSource (_, hiboot_map) = (True,  lookupFM hiboot_map mod_name)
+
+    find_path ImportBySystem     (hi_map, hiboot_map)
+      | hi_file
+      =                -- If the module we seek is in our dependent set, 
+               -- Look for a .hi file
+         (False, lookupFM hi_map mod_name)
+
+      | otherwise
+               -- Check if there's a library module of that name
+               -- If not, look for an hi-boot file
+      = case lookupFM hi_map mod_name of
+          stuff@(Just (_, mod)) | isLibModule mod -> (False, stuff)
+          other                                   -> (True, lookupFM hiboot_map mod_name)
+
+    trace_msg = sep [hsep [ptext SLIT("Reading"), 
+                          ppr from,
+                          ptext SLIT("interface for"), 
+                          pprModuleName mod_name <> semi],
+                    nest 4 (ptext SLIT("reason:") <+> doc_str)]
 \end{code}
 
 \end{code}
 
-@readIface@ trys just one file.
+@readIface@ tries just the one file.
 
 \begin{code}
 
 \begin{code}
-readIface :: String -> RnMG (Maybe ParsedIface)        
+readIface :: Module -> String -> RnM d (Maybe (Module, ParsedIface))
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
        -- Nothing <=> file not found, or unreadable, or illegible
        -- Just x  <=> successfully found and parsed 
-readIface file_path
-  = ioToRnMG (hGetStringBuffer file_path)      `thenRn` \ read_result ->
---OLD:  = ioToRnMG (readFile file_path)        `thenRn` \ read_result ->
+readIface the_mod file_path
+  = ioToRnM (hGetStringBuffer False file_path)       `thenRn` \ read_result ->
     case read_result of
     case read_result of
-       Right contents    -> case parseIface contents of
-                               Failed err      -> --ioToRnMG (freeStringBuffer contents) `thenRn` \ _ -> 
-                                                  failWithRn Nothing err 
-                               Succeeded iface -> --ioToRnMG (freeStringBuffer contents) `thenRn` \ _ ->
-                                                  returnRn (Just iface)
-
-       Left  (NoSuchThing _) -> returnRn Nothing
-
-       Left  err             -> failWithRn Nothing
-                                           (cannaeReadFile file_path err)
-
-\end{code}
-
-mkSearchPath takes a string consisting of a colon-separated list of directories, and turns it into
-a list of directories.  For example:
-
-       mkSearchPath "foo:.:baz"  =  ["foo", ".", "baz"]
-
-\begin{code}
-mkSearchPath :: Maybe String -> SearchPath
-mkSearchPath Nothing = ["."]
-mkSearchPath (Just s)
-  = go s
-  where
-    go "" = []
-    go s  = first : go (drop 1 rest)
-         where
-           (first,rest) = span (/= ':') s
+       Right contents    -> 
+             case parseIface contents
+                       PState{ bol = 0#, atbol = 1#,
+                               context = [],
+                               glasgow_exts = 1#,
+                               loc = mkSrcLoc (mkFastString file_path) 1 } of
+                 PFailed err                    -> failWithRn Nothing err 
+                 POk _  (PIface mod_nm iface) ->
+                           warnCheckRn (mod_nm == moduleName the_mod)
+                                       (hsep [ ptext SLIT("Something is amiss; requested module name")
+                                               , pprModule the_mod
+                                               , ptext SLIT("differs from name found in the interface file ")
+                                               , pprModuleName mod_nm
+                                               ])                                `thenRn_`
+                           returnRn (Just (the_mod, iface))
+
+        Left err
+         | isDoesNotExistError err -> returnRn Nothing
+         | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
 \end{code}
 
 %*********************************************************
 \end{code}
 
 %*********************************************************
-%*                                                     *
+%*                                                      *
 \subsection{Errors}
 \subsection{Errors}
-%*                                                     *
+%*                                                      *
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-noIfaceErr mod sty
-  = ppBesides [ppPStr SLIT("Could not find valid interface file for "), ppQuote (pprModule sty mod)]
---     , ppStr " in"]) 4 (ppAboves (map ppStr dirs))
-
-cannaeReadFile file err sty
-  = ppBesides [ppPStr SLIT("Failed in reading file: "), ppStr file, ppPStr SLIT("; error="), ppStr (show err)]
-
-getDeclErr name sty
-  = ppSep [ppPStr SLIT("Failed to find interface decl for"), ppr sty name]
-
-getDeclWarn name sty
-  = ppSep [ppPStr SLIT("Warning: failed to find (optional) interface decl for"), ppr sty name]
+noIfaceErr filename boot_file
+  = hsep [ptext SLIT("Could not find valid"), boot, 
+         ptext SLIT("interface file"), quotes (pprModule filename)]
+  where
+    boot | boot_file = ptext SLIT("[boot]")
+        | otherwise = empty
+
+cannaeReadFile file err
+  = hcat [ptext SLIT("Failed in reading file: "), 
+          text file, 
+         ptext SLIT("; error="), 
+         text (show err)]
+
+getDeclErr name
+  = ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name)
+
+getDeclWarn name loc
+  = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
+        ptext SLIT("desired at") <+> ppr loc]
+
+importDeclWarn mod name
+  = sep [ptext SLIT("Compiler tried to import decl from interface file with same name as module."), 
+        ptext SLIT("(possible cause: module name clashes with interface file already in scope.)")
+       ] $$
+    hsep [ptext SLIT("Interface:"), quotes (pprModuleName mod), 
+         comma, ptext SLIT("name:"), quotes (ppr name)]
+
+warnRedundantSourceImport mod_name
+  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module") <+> quotes (pprModuleName mod_name)
 \end{code}
 \end{code}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)