[project @ 2005-03-10 14:03:28 by simonmar]

[ghc-hetmet.git] / ghc / compiler / iface / LoadIface.lhs

diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs
index b63849d..a760b83 100644 (file)
--- a/ghc/compiler/iface/LoadIface.lhs
+++ b/ghc/compiler/iface/LoadIface.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module LoadIface (
-       loadHomeInterface, loadInterface,
+       loadHomeInterface, loadInterface, loadDecls,
        loadSrcInterface, loadOrphanModules, loadHiBootInterface,
        readIface,      -- Used when reading the module's old interface
        predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
@@ -24,15 +24,13 @@ import IfaceSyn             ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
                          IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..), 
                          IfaceType(..), IfacePredType(..), IfaceExtName,
                          mkIfaceExtName )
-import IfaceEnv                ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc,
-                         lookupOrig )
+import IfaceEnv                ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc, lookupAvail )
 import HscTypes                ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
                          addEpsInStats, ExternalPackageState(..),
                          PackageTypeEnv, emptyTypeEnv,  
                          lookupIfaceByModule, emptyPackageIfaceTable,
                          IsBootInterface, mkIfaceFixCache, Gated,
-                         implicitTyThings, addRulesToPool, addInstsToPool,
-                         availNames
+                         implicitTyThings, addRulesToPool, addInstsToPool
                         )
 
 import BasicTypes      ( Version, Fixity(..), FixityDirection(..),
@@ -120,9 +118,10 @@ loadHiBootInterface
 
     do {       -- Load it (into the PTE), and return the exported names
          iface <- loadSrcInterface (mk_doc mod_nm) mod_nm True
-       ; sequenceM [ lookupOrig mod_nm occ
-                   | (mod,avails) <- mi_exports iface, 
-                     avail <- avails, occ <- availNames avail]
+       ; ns_s <-  sequenceM [ lookupAvail mod_nm avail
+                            | (mod,avails) <- mi_exports iface, 
+                              avail <- avails ]
+       ; return (concat ns_s)
     }}}
   where
     mk_doc mod = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
@@ -262,8 +261,8 @@ loadInterface doc_str mod from
        --      explicitly tag each export which seems a bit of a bore)
 
        ; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
-       ; new_eps_decls <- mapM (loadDecl ignore_prags) (mi_decls iface)
-       ; new_eps_insts <- mapM loadInst                (mi_insts iface)
+       ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
+       ; new_eps_insts <- mapM loadInst (mi_insts iface)
        ; new_eps_rules <- if ignore_prags 
                           then return []
                           else mapM loadRule (mi_rules iface)
@@ -297,21 +296,35 @@ badDepMsg mod
 -- the declaration itself, will find the fully-glorious Name
 -----------------------------------------------------
 
-addDeclsToPTE :: PackageTypeEnv -> [[(Name,TyThing)]] -> PackageTypeEnv
-addDeclsToPTE pte things = foldl extendNameEnvList pte things
+addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
+addDeclsToPTE pte things = extendNameEnvList pte things
+
+loadDecls :: Bool
+         -> [(Version, IfaceDecl)]
+         -> IfL [(Name,TyThing)]
+loadDecls ignore_prags ver_decls
+   = do { mod <- getIfModule
+       ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
+       ; return (concat thingss)
+       }
 
 loadDecl :: Bool                       -- Don't load pragmas into the decl pool
+        -> Module
          -> (Version, IfaceDecl)
          -> IfL [(Name,TyThing)]       -- The list can be poked eagerly, but the
                                        -- TyThings are forkM'd thunks
-loadDecl ignore_prags (_version, decl)
+loadDecl ignore_prags mod (_version, decl)
   = do         {       -- Populate the name cache with final versions of all 
                -- the names associated with the decl
-         mod <- getIfModule
-       ; main_name      <- mk_new_bndr mod Nothing (ifName decl)
+         main_name      <- mk_new_bndr mod Nothing (ifName decl)
        ; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
 
        -- Typecheck the thing, lazily
+       -- NB. firstly, the laziness is there in case we never need the
+       -- declaration (in one-shot mode), and secondly it is there so that 
+       -- we don't look up the occurrence of a name before calling mk_new_bndr
+       -- on the binder.  This is important because we must get the right name
+       -- which includes its nameParent.
        ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
        ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
              lookup n = case lookupOccEnv mini_env (getOccName n) of