projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1999-05-18 14:56:06 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnIfaces.lhs
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index eebe37e..ff21596 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -5,66 +5,60 @@
 
 \begin{code}
 module RnIfaces (
 
 \begin{code}
 module RnIfaces (
-       getInterfaceExports,
-       getImportedInstDecls,
-       getSpecialInstModules, getDeferredDataDecls,
+       getInterfaceExports, 
+       getImportedInstDecls, getImportedRules,
+       lookupFixity, loadHomeInterface,
        importDecl, recordSlurp,
        importDecl, recordSlurp,
-       getImportVersions, getSlurpedNames, getRnStats, getImportedFixities,
+       getImportVersions, getSlurped,
 
        checkUpToDate,
 
 
        checkUpToDate,
 
-       getDeclBinders,
-       mkSearchPath
+       getDeclBinders
     ) where
 
 #include "HsVersions.h"
 
     ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts     ( opt_PruneTyDecls,  opt_PruneInstDecls, 
-                         opt_D_show_rn_imports, opt_IgnoreIfacePragmas
-                       )
+import CmdLineOpts     ( opt_NoPruneDecls, opt_IgnoreIfacePragmas )
 import HsSyn           ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
                          HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
 import HsSyn           ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
                          HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
-                         FixitySig(..),
-                         hsDeclName, countTyClDecls, isDataDecl, isClassOpSig
+                         FixitySig(..), RuleDecl(..),
+                         isClassOpSig
                        )
                        )
-import BasicTypes      ( Version, NewOrData(..) )
-import RdrHsSyn                ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl,
+import BasicTypes      ( Version, NewOrData(..), defaultFixity )
+import RdrHsSyn                ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl, RdrNameRuleDecl,
+                         extractHsTyRdrNames
                        )
                        )
-import RnEnv           ( newImportedGlobalName, newImportedGlobalFromRdrName, 
-                         addImplicitOccsRn, pprAvail,
-                         availName, availNames, addAvailToNameSet
+import RnEnv           ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdrName,
+                         lookupOccRn,
+                         pprAvail,
+                         availName, availNames, addAvailToNameSet,
+                         FreeVars, emptyFVs
                        )
                        )
-import RnSource                ( rnHsSigType )
 import RnMonad
 import RnHsSyn          ( RenamedHsDecl )
 import ParseIface      ( parseIface, IfaceStuff(..) )
 
 import FiniteMap       ( FiniteMap, sizeFM, emptyFM, delFromFM,
                          lookupFM, addToFM, addToFM_C, addListToFM, 
 import RnMonad
 import RnHsSyn          ( RenamedHsDecl )
 import ParseIface      ( parseIface, IfaceStuff(..) )
 
 import FiniteMap       ( FiniteMap, sizeFM, emptyFM, delFromFM,
                          lookupFM, addToFM, addToFM_C, addListToFM, 
-                         fmToList
+                         fmToList, elemFM, foldFM
                        )
 import Name            ( Name {-instance NamedThing-},
                          nameModule, isLocallyDefined,
                        )
 import Name            ( Name {-instance NamedThing-},
                          nameModule, isLocallyDefined,
-                         isWiredInName, maybeWiredInTyConName,
-                         maybeWiredInIdName, nameUnique, NamedThing(..),
-                         pprEncodedFS
+                         isWiredInName, nameUnique, NamedThing(..)
                         )
                         )
-import Module          ( Module, mkBootModule, moduleString, pprModule, 
-                         mkDynamicModule, moduleIfaceFlavour, bootFlavour, hiFile,
-                         moduleUserString, moduleFS, setModuleFlavour
+import Module          ( Module, moduleString, pprModule,
+                         mkVanillaModule, pprModuleName,
+                         moduleUserString, moduleName, isLibModule,
+                         ModuleName, WhereFrom(..),
                        )
 import RdrName         ( RdrName, rdrNameOcc )
 import NameSet
                        )
 import RdrName         ( RdrName, rdrNameOcc )
 import NameSet
-import Id              ( idType, isDataConId_maybe )
-import DataCon         ( dataConTyCon, dataConType )
-import TyCon           ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
-import Type            ( namesOfType )
 import Var             ( Id )
 import SrcLoc          ( mkSrcLoc, SrcLoc )
 import PrelMods                ( pREL_GHC )
 import PrelInfo                ( cCallishTyKeys, thinAirModules )
 import Bag
 import Var             ( Id )
 import SrcLoc          ( mkSrcLoc, SrcLoc )
 import PrelMods                ( pREL_GHC )
 import PrelInfo                ( cCallishTyKeys, thinAirModules )
 import Bag
-import Maybes          ( MaybeErr(..), maybeToBool )
+import Maybes          ( MaybeErr(..), maybeToBool, orElse )
 import ListSetOps      ( unionLists )
 import Outputable
 import Unique          ( Unique )
 import ListSetOps      ( unionLists )
 import Outputable
 import Unique          ( Unique )
@@ -77,86 +71,6 @@ import List  ( nub )
 \end{code}
 
 
 \end{code}
 
 
-
-%*********************************************************
-%*                                                     *
-\subsection{Statistics}
-%*                                                     *
-%*********************************************************
-
-\begin{code}
-getRnStats :: [RenamedHsDecl] -> RnMG SDoc
-getRnStats all_decls
-  = getIfacesRn                `thenRn` \ ifaces ->
-    let
-       n_mods      = sizeFM (iModMap ifaces)
-
-       decls_imported = filter is_imported_decl all_decls
-
-       decls_read     = [decl | (_, avail, decl, True) <- nameEnvElts (iDecls ifaces),
-                                       -- Data, newtype, and class decls are in the decls_fm
-                                       -- under multiple names; the tycon/class, and each
-                                       -- constructor/class op too.
-                                       -- The 'True' selects just the 'main' decl
-                                not (isLocallyDefined (availName avail))
-                            ]
-
-       (cd_rd, dd_rd, add_rd, nd_rd, and_rd, sd_rd, vd_rd,     _) = count_decls decls_read
-       (cd_sp, dd_sp, add_sp, nd_sp, and_sp, sd_sp, vd_sp, id_sp) = count_decls decls_imported
-
-       (unslurped_insts, _)  = iDefInsts ifaces
-       inst_decls_unslurped  = length (bagToList unslurped_insts)
-       inst_decls_read       = id_sp + inst_decls_unslurped
-
-       stats = vcat 
-               [int n_mods <> text " interfaces read",
-                hsep [ int cd_sp, text "class decls imported, out of", 
-                       int cd_rd, text "read"],
-                hsep [ int dd_sp, text "data decls imported (of which", int add_sp, 
-                       text "abstractly), out of",  
-                       int dd_rd, text "read"],
-                hsep [ int nd_sp, text "newtype decls imported (of which", int and_sp, 
-                       text "abstractly), out of",  
-                       int nd_rd, text "read"],
-                hsep [int sd_sp, text "type synonym decls imported, out of",  
-                       int sd_rd, text "read"],
-                hsep [int vd_sp, text "value signatures imported, out of",  
-                       int vd_rd, text "read"],
-                hsep [int id_sp, text "instance decls imported, out of",  
-                       int inst_decls_read, text "read"]
-               ]
-    in
-    returnRn (hcat [text "Renamer stats: ", stats])
-
-is_imported_decl (DefD _) = False
-is_imported_decl (ValD _) = False
-is_imported_decl decl     = not (isLocallyDefined (hsDeclName decl))
-
-count_decls decls
-  = -- pprTrace "count_decls" (ppr  decls
-    --
-    --                     $$
-    --                     text "========="
-    --                     $$
-    --                     ppr imported_decls
-    -- ) $
-    (class_decls, 
-     data_decls,    abstract_data_decls,
-     newtype_decls, abstract_newtype_decls,
-     syn_decls, 
-     val_decls, 
-     inst_decls)
-  where
-    tycl_decls = [d | TyClD d <- decls]
-    (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
-    abstract_data_decls    = length [() | TyData DataType _ _ _ [] _ _ _ <- tycl_decls]
-    abstract_newtype_decls = length [() | TyData NewType  _ _ _ [] _ _ _ <- tycl_decls]
-
-    val_decls     = length [() | SigD _          <- decls]
-    inst_decls    = length [() | InstD _  <- decls]
-
-\end{code}    
-
 %*********************************************************
 %*                                                     *
 \subsection{Loading a new interface file}
 %*********************************************************
 %*                                                     *
 \subsection{Loading a new interface file}
@@ -164,94 +78,106 @@ count_decls decls
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-loadHomeInterface :: SDoc -> Name -> RnMG (Module, Ifaces)
+loadHomeInterface :: SDoc -> Name -> RnM d (Module, Ifaces)
 loadHomeInterface doc_str name
 loadHomeInterface doc_str name
-  = loadInterface doc_str (nameModule name)
+  = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
 
 
-loadInterface :: SDoc -> Module -> RnMG (Module, Ifaces)
-loadInterface doc_str load_mod
- = getIfacesRn                 `thenRn` \ ifaces ->
+loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Module, Ifaces)
+loadInterface doc_str mod_name from
+ = getIfacesRn                         `thenRn` \ ifaces ->
    let
    let
-       hi_boot_wanted       = bootFlavour (moduleIfaceFlavour load_mod)
-       mod_map              = iModMap ifaces
-       (insts, tycls_names) = iDefInsts ifaces
-       
+       mod_map  = iImpModInfo ifaces
+       mod_info = lookupFM mod_map mod_name
+       in_map   = maybeToBool mod_info
    in
    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
-   case lookupFM mod_map load_mod of {
-       Just (existing_hif, _, _) 
-               | hi_boot_wanted || not (bootFlavour existing_hif)
-               ->      -- Already in the cache, and new version is no better than old,
-                       -- so don't re-read it
-                   returnRn (setModuleFlavour existing_hif load_mod, ifaces) ;
-       other ->
+   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 ->
+   findAndReadIface doc_str mod_name from in_map       `thenRn` \ (hi_boot_read, read_result) ->
    case read_result of {
    case read_result of {
-       Nothing | not hi_boot_wanted && load_mod `elem` thinAirModules
-               -> -- Hack alert!  When compiling PrelBase we have to load the
-                  -- decls for packCString# and friends; they are 'thin-air' Ids
-                  -- (see PrelInfo.lhs).  So if we don't find the HiFile we quietly
-                  -- look for a .hi-boot file instead, and use that
-                  --
-                  -- NB this causes multiple "failed" attempts to read PrelPack,
-                  --    which makes curious reading with -dshow-rn-trace, but
-                  --    there's no harm done
-                  loadInterface doc_str (mkBootModule load_mod)
-
-              
-               | otherwise
-               ->      -- Not found, so add an empty export env to the Ifaces map
+       Nothing ->      -- Not found, so add an empty export env to the Ifaces map
                        -- so that we don't look again
                   let
                        -- so that we don't look again
                   let
-                       new_mod_map = addToFM mod_map load_mod (hiFile, 0, [])
-                       new_ifaces = ifaces { iModMap = new_mod_map }
+                       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 (load_mod, new_ifaces) (noIfaceErr load_mod) ;
+                  failWithRn (mod, new_ifaces) (noIfaceErr mod hi_boot_read) ;
 
        -- Found and parsed!
 
        -- Found and parsed!
-       Just (the_mod, ParsedIface mod_vers usages exports rd_inst_mods rd_decls rd_insts) ->
-
+       Just (mod, iface) ->
 
        -- LOAD IT INTO Ifaces
 
        -- LOAD IT INTO Ifaces
-       -- First set the module
 
        -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
        ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
        --     If we do loadExport first the wrong info gets into the cache (unless we
        --      explicitly tag each export which seems a bit of a bore)
 
 
        -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
        ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
        --     If we do loadExport first the wrong info gets into the cache (unless we
        --      explicitly tag each export which seems a bit of a bore)
 
-    getModuleRn                `thenRn` \ this_mod ->
-    setModuleRn the_mod  $     -- First set the module name of the module being loaded,
-                               -- so that unqualified occurrences in the interface file
-                               -- get the right qualifer
-    foldlRn loadDecl (iDecls ifaces) rd_decls          `thenRn` \ new_decls ->
-    foldlRn loadFixDecl (iFixes ifaces) rd_decls       `thenRn` \ new_fixities ->
-    foldlRn loadInstDecl insts rd_insts                        `thenRn` \ new_insts ->
-
-    mapRn (loadExport this_mod) exports                        `thenRn` \ avails_s ->
+    getModuleRn                `thenRn` \ this_mod_nm ->
     let
     let
-         -- Notice: the 'flavour' of the loaded Module does not have to 
-         --  be the same as the requested Module.
-        the_mod_hif = moduleIfaceFlavour the_mod
-        mod_details = (the_mod_hif, mod_vers, concat avails_s)
-
-                       -- Exclude this module from the "special-inst" modules
-        new_inst_mods = iInstMods ifaces `unionLists` (filter (/= this_mod) rd_inst_mods)
-
-        new_ifaces = ifaces { iModMap   = addToFM mod_map the_mod mod_details,
-                              iDecls    = new_decls,
-                              iFixes    = new_fixities,
-                              iDefInsts = (new_insts, tycls_names),
-                              iInstMods = new_inst_mods  }
+       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
+       -- 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 (the_mod, new_ifaces)
+    returnRn (mod, new_ifaces)
     }}
 
     }}
 
-loadExport :: Module -> ExportItem -> RnMG [AvailInfo]
+addModDeps :: Module -> ImportedModuleInfo
+          -> [ImportVersion a] -> ImportedModuleInfo
+addModDeps mod mod_deps new_deps
+  = foldr add mod_deps new_deps
+  where
+    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.
 loadExport this_mod (mod, entities)
   | mod == this_mod = returnRn []
        -- If the module exports anything defined in this module, just ignore it.
@@ -271,10 +197,9 @@ loadExport this_mod (mod, entities)
        -- but it's a bogus thing to do!
 
   | otherwise
        -- but it's a bogus thing to do!
 
   | otherwise
-  = setModuleFlavourRn mod `thenRn` \ mod' ->
-    mapRn (load_entity mod') entities
+  = mapRn (load_entity mod) entities
   where
   where
-    new_name mod occ = newImportedGlobalName mod occ
+    new_name mod occ = mkImportedGlobalName mod occ
 
     load_entity mod (Avail occ)
       =        new_name mod occ        `thenRn` \ name ->
 
     load_entity mod (Avail occ)
       =        new_name mod occ        `thenRn` \ name ->
@@ -285,27 +210,28 @@ loadExport this_mod (mod, entities)
         returnRn (AvailTC name names)
 
 
         returnRn (AvailTC name names)
 
 
-loadFixDecl :: FixityEnv 
+loadFixDecl :: ModuleName -> FixityEnv
            -> (Version, RdrNameHsDecl)
            -> (Version, RdrNameHsDecl)
-           -> RnMG FixityEnv
-loadFixDecl fixity_env (version, FixD (FixitySig rdr_name fixity loc))
+           -> 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
   =    -- 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
-    newImportedGlobalFromRdrName rdr_name      `thenRn` \ name ->
+    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
 
        -- Ignore the other sorts of decl
     let
        new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
     in
     returnRn new_fixity_env
 
        -- Ignore the other sorts of decl
-loadFixDecl fixity_env other_decl = returnRn fixity_env
+loadFixDecl mod_name fixity_env other_decl = returnRn fixity_env
 
 
-loadDecl :: DeclsMap
+loadDecl :: Module 
+        -> DeclsMap
         -> (Version, RdrNameHsDecl)
         -> (Version, RdrNameHsDecl)
-        -> RnMG DeclsMap
+        -> RnM d DeclsMap
 
 
-loadDecl decls_map (version, decl)
+loadDecl mod decls_map (version, decl)
   = getDeclBinders new_name decl       `thenRn` \ maybe_avail ->
     case maybe_avail of {
        Nothing -> returnRn decls_map;  -- No bindings
   = getDeclBinders new_name decl       `thenRn` \ maybe_avail ->
     case maybe_avail of {
        Nothing -> returnRn decls_map;  -- No bindings
@@ -315,7 +241,7 @@ loadDecl decls_map (version, decl)
     let
        main_name     = availName avail
        new_decls_map = foldl add_decl decls_map
     let
        main_name     = availName avail
        new_decls_map = foldl add_decl decls_map
-                                      [ (name, (version,avail,decl',name==main_name)) 
+                                      [ (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 )
                                       | name <- sys_bndrs ++ availNames avail]
        add_decl decls_map (name, stuff)
          = WARN( name `elemNameEnv` decls_map, ppr name )
@@ -324,7 +250,11 @@ loadDecl decls_map (version, decl)
     returnRn new_decls_map
     }
   where
     returnRn new_decls_map
     }
   where
-    new_name rdr_name loc = newImportedGlobalFromRdrName 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.
     {-
       If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
       we toss away unfolding information.
@@ -341,16 +271,15 @@ loadDecl decls_map (version, decl)
        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?]
     -}
        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)
-       _ -> decl
+    decl' = case decl of
+              SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas ->  SigD (IfaceSig name tp [] loc)
+              other                                                   -> decl
 
 
-loadInstDecl :: Bag IfaceInst
+loadInstDecl :: Module
+            -> Bag GatedDecl
             -> RdrNameInstDecl
             -> RdrNameInstDecl
-            -> RnMG (Bag IfaceInst)
-loadInstDecl 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
@@ -365,16 +294,20 @@ loadInstDecl insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
        munged_inst_ty = case inst_ty of
                                HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
                                other                 -> inst_ty
        munged_inst_ty = case inst_ty of
                                HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
                                other                 -> 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 free variables of the type
-    initRnMS emptyRnEnv vanillaInterfaceMode (
-        discardOccurrencesRn (rnHsSigType (text "an instance decl") munged_inst_ty)
-    )                                          `thenRn` \ (_, gate_names) ->
-    getModuleRn                                        `thenRn` \ mod_name -> 
-    returnRn (((mod_name, decl), gate_names) `consBag` insts)
-
-vanillaInterfaceMode = InterfaceMode Compulsory
+    setModuleRn (moduleName mod) $
+    mapRn mkImportedGlobalFromRdrName free_names       `thenRn` \ gate_names ->
+    returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)
+
+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}
 
 
@@ -385,45 +318,51 @@ vanillaInterfaceMode = InterfaceMode Compulsory
 %********************************************************
 
 \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
                    traceRn (sep [ptext SLIT("Didnt find old iface"), 
 
        -- CHECK WHETHER WE HAVE IT ALREADY
     case read_result of
        Nothing ->      -- Old interface file not found, so we'd better bail out
                    traceRn (sep [ptext SLIT("Didnt find old iface"), 
-                                   pprModule mod_name])        `thenRn_`
+                                 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 = sep [ptext SLIT("need usage info from"), pprModule 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, whats_imported) : rest)
-  = loadInterface doc_str mod          `thenRn` \ (mod, ifaces) ->
+checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
+  = loadInterface doc_str mod_name ImportBySystem      `thenRn` \ (mod, ifaces) ->
     let
     let
-       maybe_new_mod_vers        = lookupFM (iModMap ifaces) 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
-       traceRn (sep [ptext SLIT("Can't find version number for module"), pprModule mod]) `thenRn_`
-       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 (sep [ptext SLIT("Module version unchanged:"), pprModule mod])  `thenRn_`
+       traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name]) `thenRn_`
        checkModUsage rest
     else
        checkModUsage rest
     else
-    traceRn (sep [ptext SLIT("Module version has changed:"), pprModule mod])   `thenRn_`
+    traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name])  `thenRn_`
 
        -- Module version changed, so check entities inside
 
 
        -- Module version changed, so check entities inside
 
@@ -437,22 +376,22 @@ checkModUsage ((mod, old_mod_vers, whats_imported) : rest)
       Specifically old_local_vers ->
 
        -- Non-empty usage list, so check item by item
       Specifically old_local_vers ->
 
        -- Non-empty usage list, so check item by item
-    checkEntityUsage mod (iDecls ifaces) old_local_vers        `thenRn` \ up_to_date ->
+    checkEntityUsage mod_name (iDecls ifaces) old_local_vers   `thenRn` \ up_to_date ->
     if up_to_date then
        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
     if up_to_date then
        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
-    }
+    }}
   where
   where
-    doc_str = sep [ptext SLIT("need version info for"), pprModule 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)
-  = newImportedGlobalName mod occ_name                 `thenRn` \ name ->
+  = mkImportedGlobalName mod occ_name  `thenRn` \ name ->
     case lookupNameEnv decls name of
 
        Nothing       ->        -- We used it before, but it ain't there now
     case lookupNameEnv decls name of
 
        Nothing       ->        -- We used it before, but it ain't there now
@@ -478,57 +417,48 @@ checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-importDecl :: Occurrence -> RnMode -> RnMG (Maybe RdrNameHsDecl)
-       -- Returns Nothing for a wired-in or already-slurped decl
-
-importDecl (name, loc) mode
-  = checkSlurped name                  `thenRn` \ already_slurped ->
-    if already_slurped then
---     traceRn (sep [text "Already slurped:", ppr 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 mode
-    else 
-       getIfacesRn             `thenRn` \ ifaces ->
-       let
-         mod = nameModule name
-       in
-       if mod == iMod ifaces then    -- Don't bring in decls from
-         addWarnRn (importDeclWarn mod name loc) `thenRn_`
---       pprTrace "importDecl wierdness:" (ppr name) $
-         returnRn Nothing         -- the renamed module's own interface file
-                                  -- 
-       else
-       getNonWiredInDecl name loc mode
+       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 -> SrcLoc -> RnMode -> RnMG (Maybe RdrNameHsDecl)
-getNonWiredInDecl needed_name loc mode
+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
 
   = traceRn doc_str                            `thenRn_`
     loadHomeInterface doc_str needed_name      `thenRn` \ (_, ifaces) ->
     case lookupNameEnv (iDecls ifaces) needed_name of
 
-       -- Special case for data/newtype type declarations
-      Just (version, avail, TyClD tycl_decl, _) | isDataDecl tycl_decl
-       -> getNonWiredDataDecl needed_name version avail tycl_decl      `thenRn` \ (avail', maybe_decl) ->
-          recordSlurp (Just version) necessity avail'                  `thenRn_`
-          returnRn maybe_decl
-
-      Just (version,avail,decl,_)
-       -> recordSlurp (Just version) necessity avail   `thenRn_`
+      Just (version,avail,_,decl)
+       -> recordSlurp (Just version) avail     `thenRn_`
           returnRn (Just decl)
 
           returnRn (Just decl)
 
-      Nothing ->       -- Can happen legitimately for "Optional" occurrences
-                  case necessity of { 
-                       Optional -> addWarnRn (getDeclWarn needed_name loc);
-                       other    -> addErrRn  (getDeclErr  needed_name loc)
-                  }                                            `thenRn_` 
-                  returnRn Nothing
+      Nothing          -- Can happen legitimately for "Optional" occurrences
+       -> addErrRn (getDeclErr needed_name)    `thenRn_` 
+          returnRn Nothing
   where
   where
-     necessity = modeToNecessity mode
-     doc_str = sep [ptext SLIT("need decl for"), ppr needed_name, ptext SLIT("needed at"), ppr loc]
+     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.
@@ -550,95 +480,6 @@ 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 mode
-  = setModuleRn mod_name (
-       initRnMS emptyRnEnv new_mode get_wired
-    )                                          `thenRn` \ avail ->
-    recordSlurp Nothing necessity 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        = nameModule main_name
-       doc_str    = sep [ptext SLIT("need home module for wired in thing"), ppr name]
-    in
-    (if not main_is_tc || mod == pREL_GHC then
-       returnRn ()             
-    else
-       loadHomeInterface doc_str main_name     `thenRn_`
-       returnRn ()
-    )                                          `thenRn_`
-
-    returnRn Nothing           -- No declaration to process further
-  where
-    necessity = modeToNecessity mode
-    new_mode = case mode of 
-                       InterfaceMode _ -> mode
-                       SourceMode      -> vanillaInterfaceMode
-
-    get_wired | is_tycon                       -- ... a type constructor
-             = get_wired_tycon the_tycon
-
-             | maybeToBool maybe_data_con              -- ... a wired-in data constructor
-             = get_wired_tycon (dataConTyCon data_con)
-
-             | otherwise                       -- ... a wired-in non data-constructor
-             = get_wired_id the_id
-
-    mod_name            = nameModule name
-    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
-    maybe_data_con      = isDataConId_maybe the_id
-    Just data_con       = maybe_data_con
-
-
-get_wired_id id
-  = addImplicitOccsRn id_mentions      `thenRn_`
-    returnRn (Avail (getName id))
-  where
-    id_mentions = nameSetToList (namesOfType ty)
-    ty = idType id
-
-get_wired_tycon tycon 
-  | isSynTyCon tycon
-  = addImplicitOccsRn (nameSetToList mentioned)                `thenRn_`
-    returnRn (AvailTC tc_name [tc_name])
-  where
-    tc_name     = getName tycon
-    (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 . dataConType) emptyNameSet data_cons
-\end{code}
 
 
     
 
 
     
@@ -648,187 +489,100 @@ get_wired_tycon tycon
 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 
+@getInterfaceExports@ is called only for directly-imported modules
+
 \begin{code}
 \begin{code}
-getInterfaceExports :: Module -> RnMG (Module, Avails)
-getInterfaceExports mod
-  = loadInterface doc_str mod  `thenRn` \ (mod, ifaces) ->
-    case lookupFM (iModMap ifaces) 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.)
                      returnRn (mod, [])
 
        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 (mod, [])
 
-       Just (_, _, avails) -> returnRn (mod, avails)
+       Just (_, _, Just (mod, _, avails)) -> returnRn (mod, avails)
   where
   where
-    doc_str = sep [pprModule mod, ptext SLIT("is directly imported")]
+    doc_str = sep [pprModuleName mod_name, ptext SLIT("is directly imported")]
 \end{code}
 
 
 %*********************************************************
 %*                                                     *
 \end{code}
 
 
 %*********************************************************
 %*                                                     *
-\subsection{Data type declarations are handled specially}
+\subsection{Instance declarations are handled specially}
 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 
-Data type declarations get special treatment.  If we import a data type decl
-with all its constructors, we end up importing all the types mentioned in 
-the constructors' signatures, and hence {\em their} data type decls, and so on.
-In effect, we get the transitive closure of data type decls.  Worse, this drags
-in tons on instance decls, and their unfoldings, and so on.
-
-If only the type constructor is mentioned, then all this is a waste of time.
-If any of the data constructors are mentioned then we really have to 
-drag in the whole declaration.
-
-So when we import the type constructor for a @data@ or @newtype@ decl, we
-put it in the "deferred data/newtype decl" pile in Ifaces.  Right at the end
-we slurp these decls, if they havn't already been dragged in by an occurrence
-of a constructor.
-
-\begin{code}
-getNonWiredDataDecl needed_name 
-                   version
-                   avail@(AvailTC tycon_name _) 
-                   ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
-  |  null condecls ||
-       -- HACK ALERT!  If the data type is abstract then it must from a 
-       -- hand-written hi-boot file.  We put it in the deferred pile unconditionally,
-       -- because we don't want to read it in, and then later find a decl for a constructor
-       -- from that type, read the real interface file, and read in the full data type
-       -- decl again!!!  
-
-     (needed_name == tycon_name
-     && opt_PruneTyDecls
-        -- don't prune newtypes, as the code generator may
-       -- want to peer inside a newtype type constructor
-       -- (ClosureInfo.fun_result_ty is the culprit.)
-     && not (new_or_data == NewType)
-     && not (nameUnique needed_name `elem` cCallishTyKeys))
-       -- Hack!  Don't prune these tycons whose constructors
-       -- the desugarer must be able to see when desugaring
-       -- a CCall.  Ugh!
-
-  =    -- Need the type constructor; so put it in the deferred set for now
-    getIfacesRn                `thenRn` \ ifaces ->
-    let
-       deferred_data_decls = iDefData ifaces
-       new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
-
-       no_constr_ty_decl       = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
-       new_deferred_data_decls = addToNameEnv deferred_data_decls tycon_name 
-                                              (nameModule tycon_name, no_constr_ty_decl)
-               -- Nota bene: we nuke both the constructors and the context in the deferred decl.
-               -- If we don't nuke the context then renaming the deferred data decls can give
-               -- new unresolved names (for the classes).  This could be handled, but there's
-               -- no point.  If the data type is completely abstract then we aren't interested
-               -- its context.
-    in
-    setIfacesRn new_ifaces     `thenRn_`
-    returnRn (AvailTC tycon_name [tycon_name], Nothing)
-
-  | otherwise
-  =    -- Need a data constructor, so delete the data decl from the deferred set if it's there
-    getIfacesRn                `thenRn` \ ifaces ->
-    let
-       deferred_data_decls = iDefData ifaces
-       new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
-
-       new_deferred_data_decls = delFromNameEnv deferred_data_decls tycon_name
-    in
-    setIfacesRn new_ifaces     `thenRn_`
-    returnRn (avail, Just (TyClD ty_decl))
-\end{code}
-
 \begin{code}
 \begin{code}
-getDeferredDataDecls :: RnMG [(Module, RdrNameTyClDecl)]
-getDeferredDataDecls 
-  = getIfacesRn                `thenRn` \ ifaces ->
+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
     let
-       deferred_list = nameEnvElts (iDefData ifaces)
-       trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
-                       4 (ppr (map fst deferred_list))
+       orphan_mods = [mod | (mod, (_, True, Nothing)) <- fmToList (iImpModInfo ifaces)]
     in
     in
-    traceRn trace_msg                  `thenRn_`
-    returnRn deferred_list
-\end{code}
-
-
-%*********************************************************
-%*                                                     *
-\subsection{Instance declarations are handled specially}
-%*                                                     *
-%*********************************************************
-
-\begin{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_`
+    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
-       (insts, tycls_names) = iDefInsts ifaces
+       (decls, new_insts) = selectGated gates (iInsts ifaces)
+    in
+    setIfacesRn (ifaces { iInsts = new_insts })                `thenRn_`
 
 
-               -- An instance decl is ungated if all its gates have been slurped
-        select_ungated :: IfaceInst                                    -- A gated inst decl
+    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")]
 
 
-                      -> ([(Module, RdrNameInstDecl)], [IfaceInst])    -- Accumulator
+getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
+getImportedRules
+  = getIfacesRn        `thenRn` \ ifaces ->
+    let
+       gates              = iSlurp ifaces      -- Anything at all that's been slurped
+       (decls, new_rules) = selectGated gates (iRules ifaces)
+    in
+    setIfacesRn (ifaces { iRules = new_rules })                `thenRn_`
+    traceRn (sep [text "getImportedRules:", 
+                 text "Slurped" <+> int (length decls) <+> text "rules"])      `thenRn_`
+    returnRn decls
 
 
-                      -> ([(Module, RdrNameInstDecl)],                 -- The ungated ones
-                          [IfaceInst])                                 -- Still gated, but with
-                                                                       -- depeleted gates
-       select_ungated (decl,gates) (ungated_decls, gated_decls)
-         | isEmptyNameSet remaining_gates
-         = (decl : ungated_decls, gated_decls)
-         | otherwise
-         = (ungated_decls, (decl, remaining_gates) : gated_decls)
-         where
-           remaining_gates = gates `minusNameSet` tycls_names
+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
 
 
-       (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
-       
-       new_ifaces = ifaces {iDefInsts = (listToBag still_gated_insts, tycls_names)}
-                               -- NB: don't throw away tycls_names;
-                               -- we may comre across more instance decls
-    in
-    traceRn (sep [text "getInstDecls:", fsep (map ppr (nameSetToList tycls_names))])   `thenRn_`
-    setIfacesRn new_ifaces     `thenRn_`
-    returnRn un_gated_insts
+  | otherwise
+#endif
+  = foldrBag select ([], emptyBag) decl_bag
   where
   where
-    load_it mod = loadInterface (doc_str mod) mod
-    doc_str mod = sep [pprModule mod, ptext SLIT("is a special-instance module")]
-
-
-getSpecialInstModules :: RnMG [Module]
-getSpecialInstModules 
-  = getIfacesRn                                                `thenRn` \ ifaces ->
-    returnRn (iInstMods ifaces)
-
-getImportedFixities :: GlobalRdrEnv -> RnMG FixityEnv
-       -- Get all imported fixities
-       -- We first make sure that all the home modules
-       -- of all in-scope variables are loaded.
-getImportedFixities gbl_env
-  = let
-       home_modules = [ nameModule name | names <- rdrEnvElts gbl_env,
-                                          name <- names,
-                                          not (isLocallyDefined name)
-                      ]
-    in
-    mapRn_ load (nub home_modules)     `thenRn_`
-
-       -- Now we can snaffle the fixity env
-    getIfacesRn                                                `thenRn` \ ifaces ->
-    returnRn (iFixes ifaces)
+    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
   where
-    load mod = loadInterface doc_str mod
-            where
-              doc_str = ptext SLIT("Need fixities from") <+> ppr mod
+    doc = ptext SLIT("Checking fixity for") <+> ppr name
 \end{code}
 
 
 \end{code}
 
 
@@ -876,89 +630,74 @@ 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
-       mod_map   = iModMap ifaces
-       imp_names = iVSlurp ifaces
+       mod_map   = iImpModInfo ifaces
+       imp_names = iVSlurp     ifaces
 
        -- mv_map groups together all the things imported from a particular module.
 
        -- mv_map groups together all the things imported from a particular module.
-       mv_map, mv_map_mod :: FiniteMap Module (WhatsImported Name)
+       mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
 
 
-       mv_map_mod = foldl add_mod emptyFM export_mods
-               -- mv_map_mod records all the modules that have a "module M"
+               -- mv_map1 records all the modules that have a "module M"
                -- in this module's export list with an "Everything" 
                -- in this module's export list with an "Everything" 
-
-       mv_map = foldl add_mv mv_map_mod imp_names
-               -- mv_map adds the version numbers of things exported individually
-
-       mk_version_info (mod, local_versions)
-          = case lookupFM mod_map mod of
-               Just (hif, version, _) -> (mod, version, local_versions)
+       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 (map mk_version_info (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) 
+     add_mv v@(name, version) mv_map
       = addToFM_C add_item mv_map mod (Specifically [v]) 
        where
       = addToFM_C add_item mv_map mod (Specifically [v]) 
        where
-        mod = nameModule name
+        mod = moduleName (nameModule name)
 
          add_item Everything        _ = Everything
          add_item (Specifically xs) _ = Specifically (v:xs)
 
 
          add_item Everything        _ = Everything
          add_item (Specifically xs) _ = Specifically (v:xs)
 
-     add_mod mv_map mod = addToFM mv_map mod Everything
+     add_mod mod mv_map = addToFM mv_map mod Everything
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-checkSlurped name
-  = getIfacesRn        `thenRn` \ ifaces ->
-    returnRn (name `elemNameSet` iSlurp ifaces)
-
-getSlurpedNames :: RnMG NameSet
-getSlurpedNames
+getSlurped
   = getIfacesRn        `thenRn` \ ifaces ->
     returnRn (iSlurp ifaces)
 
   = getIfacesRn        `thenRn` \ ifaces ->
     returnRn (iSlurp ifaces)
 
-recordSlurp maybe_version necessity avail
-  = {- traceRn (hsep [text "Record slurp:", pprAvail avail, 
-                                       -- NB PprForDebug prints export flag, which is too
-                                       -- strict; it's a knot-tied thing in RnNames
-                 case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ])     `thenRn_` 
-    -}
-    getIfacesRn        `thenRn` \ ifaces ->
+recordSlurp maybe_version avail
+  = getIfacesRn        `thenRn` \ ifaces@(Ifaces { iSlurp  = slurped_names,
+                                                   iVSlurp = imp_names }) ->
     let
     let
-       Ifaces { iSlurp    = slurped_names,
-                iVSlurp   = imp_names,
-                iDefInsts = (insts, tycls_names) } = 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_slurped_names = addAvailToNameSet slurped_names avail
 
        new_imp_names = case maybe_version of
                           Just version -> (availName avail, version) : imp_names
                           Nothing      -> imp_names
-
-               -- Add to the names that will let in instance declarations;
-               -- but only (a) if it's a type/class
-               --          (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
-       new_tycls_names = case avail of
-                               AvailTC tc _  | not opt_PruneInstDecls || 
-                                               case necessity of {Optional -> False; Compulsory -> True }
-                                             -> tycls_names `addOneToNameSet` tc
-                               otherwise     -> tycls_names
-
-       new_ifaces = ifaces { iSlurp    = new_slurped_names,
-                             iVSlurp   = new_imp_names,
-                             iDefInsts = (insts, new_tycls_names) }
     in
     in
-    setIfacesRn new_ifaces
+    setIfacesRn (ifaces { iSlurp  = new_slurped_names,
+                         iVSlurp = new_imp_names })
 \end{code}
 
 
 \end{code}
 
 
@@ -976,9 +715,9 @@ 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 (Maybe AvailInfo)
+               -> RnM d (Maybe AvailInfo)
 
 getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
   = new_name tycon src_loc                     `thenRn` \ tycon_name ->
 
 getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
   = new_name tycon src_loc                     `thenRn` \ tycon_name ->
@@ -991,7 +730,7 @@ getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
   = new_name tycon src_loc             `thenRn` \ tycon_name ->
     returnRn (Just (AvailTC tycon_name [tycon_name]))
 
   = new_name tycon src_loc             `thenRn` \ tycon_name ->
     returnRn (Just (AvailTC tycon_name [tycon_name]))
 
-getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
+getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ _ _ _ src_loc))
   = new_name cname src_loc                     `thenRn` \ class_name ->
 
        -- Record the names for the class ops
   = new_name cname src_loc                     `thenRn` \ class_name ->
 
        -- Record the names for the class ops
@@ -1011,6 +750,7 @@ 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 (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 _ _ (RecCon fielddecls) src_loc : rest)
 
 ----------------
 getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
@@ -1040,11 +780,16 @@ 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.
 
 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}
 \begin{code}
-getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
-  = new_name dname src_loc                     `thenRn` \ datacon_name ->
-    new_name tname src_loc                     `thenRn` \ tycon_name ->
-    returnRn [tycon_name, datacon_name]
+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 []
 
 getDeclSysBinders new_name other_decl
   = returnRn []
@@ -1057,100 +802,79 @@ getDeclSysBinders new_name other_decl
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-findAndReadIface :: SDoc -> Module -> RnMG (Maybe (Module, 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_name
+findAndReadIface doc_str mod_name from hi_file
   = traceRn trace_msg                  `thenRn_`
       -- 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.
   = traceRn trace_msg                  `thenRn_`
       -- 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.
-    getModuleHiMap from_hi_boot                `thenRn` \ himap ->
-    case (lookupFM himap (moduleUserString mod_name)) of
+
+    getHiMaps                  `thenRn` \ hi_maps ->
+       
+    case find_path from hi_maps of
          -- Found the file
          -- Found the file
-       Just fpath -> readIface mod_name fpath
-       Nothing    -> traceRn (ptext SLIT("...failed")) `thenRn_`
-                    returnRn Nothing
+       (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
-    hif                 = moduleIfaceFlavour mod_name
-    from_hi_boot = bootFlavour hif
+    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"), 
 
     trace_msg = sep [hsep [ptext SLIT("Reading"), 
-                          if from_hi_boot then ptext SLIT("[boot]") else empty,
+                          ppr from,
                           ptext SLIT("interface for"), 
                           ptext SLIT("interface for"), 
-                          pprModule mod_name <> semi],
+                          pprModuleName mod_name <> semi],
                     nest 4 (ptext SLIT("reason:") <+> doc_str)]
 \end{code}
 
 @readIface@ tries just the one file.
 
 \begin{code}
                     nest 4 (ptext SLIT("reason:") <+> doc_str)]
 \end{code}
 
 @readIface@ tries just the one file.
 
 \begin{code}
-readIface :: Module -> (String, Bool) -> RnMG (Maybe (Module, 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 requested_mod (file_path, is_dll)
-  = ioToRnMG (hGetStringBuffer file_path)       `thenRn` \ read_result ->
+readIface the_mod file_path
+  = ioToRnM (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 mod_nm iface) ->
     case read_result of
        Right contents    -> 
              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
                  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
+                           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 ")
                                                , 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))
+                                               , pprModuleName mod_nm
+                                               ])                                `thenRn_`
+                           returnRn (Just (the_mod, iface))
 
         Left err
          | isDoesNotExistError err -> returnRn Nothing
          | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
 
         Left err
          | isDoesNotExistError err -> returnRn Nothing
          | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
-
-\end{code}
-
-%*********************************************************
-%*                                                      *
-\subsection{Utils}
-%*                                                      *
-%*********************************************************
-
-@mkSearchPath@ takes a string consisting of a colon-separated list
-of directories and corresponding suffixes, and turns it into a list
-of (directory, suffix) pairs.  For example:
-
-\begin{verbatim}
- mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
-   = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
-\begin{verbatim}
-
-\begin{code}
-mkSearchPath :: Maybe String -> SearchPath
-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  = 
-      case span (/= '%') s of
-       (dir,'%':rs) ->
-         case span (/= ':') rs of
-          (hisuf,_:rest) -> (dir,hisuf):go rest
-          (hisuf,[])     -> [(dir,hisuf)]
 \end{code}
 
 %*********************************************************
 \end{code}
 
 %*********************************************************
@@ -1160,9 +884,12 @@ mkSearchPath (Just s) = go s
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-noIfaceErr filename
-  = hcat [ptext SLIT("Could not find valid interface file "), 
-          quotes (pprModule filename)]
+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: "), 
 
 cannaeReadFile file err
   = hcat [ptext SLIT("Failed in reading file: "), 
@@ -1170,20 +897,20 @@ cannaeReadFile file err
          ptext SLIT("; error="), 
          text (show err)]
 
          ptext SLIT("; error="), 
          text (show err)]
 
-getDeclErr name loc
-  = sep [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name), 
-        ptext SLIT("needed at") <+> ppr loc]
+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]
 
 
 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 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.)")
        ] $$
   = 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 (pprModule mod), comma, ptext SLIT("name:"), quotes (ppr name), 
-         comma, ptext SLIT("desired at:"), ppr loc
-         ]
+    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)