[project @ 2005-02-21 14:07:07 by simonmar]

Fix a recompilation bug caused by the fact that typecheckIface wasn't
going via loadDecl to create the binders properly.  The fix actually
results in slightly cleaner code.

diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs
index b63849d..e5e7a5a 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,
@@ -262,8 +262,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 +297,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

diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 4868ba7..0167fdb 100644 (file)
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -13,7 +13,8 @@ module TcIface (
 #include "HsVersions.h"
 
 import IfaceSyn
-import LoadIface       ( loadHomeInterface, loadInterface, predInstGates, discardDeclPrags )
+import LoadIface       ( loadHomeInterface, loadInterface, predInstGates,
+                         discardDeclPrags, loadDecls )
 import IfaceEnv                ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, lookupOrig,
                          extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
                          tcIfaceTyVar, tcIfaceLclId,
@@ -177,30 +178,18 @@ typecheckIface hsc_env iface
                -- It's not actually *wrong* to do so, but in fact GHCi is unable 
                -- to handle unboxed tuples, so it must not see unfoldings.
          ignore_prags <- doptM Opt_IgnoreInterfacePragmas
-       ; let { decls | ignore_prags = map (discardDeclPrags . snd) (mi_decls iface)
-                     | otherwise    = map snd (mi_decls iface)
-             ; rules | ignore_prags = []
-                     | otherwise    = mi_rules iface
-             ; dfuns    = mi_insts iface
-             ; mod      = mi_module iface
-         }
-               -- Typecheck the decls
-       ; names <- mappM (lookupOrig mod . ifName) decls
-       ; ty_things <- fixM (\ rec_ty_things -> do
-               { writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things))
-                       -- This only makes available the "main" things,
-                       -- but that's enough for the strictly-checked part
-               ; mapM tcIfaceDecl decls })
-       
-               -- Now augment the type envt with all the implicit things
-               -- These will be needed when type-checking the unfoldings for
-               -- the IfaceIds, but this is done lazily, so writing the thing
-               -- now is sufficient
-       ; let   { add_implicits main_thing = main_thing : implicitTyThings main_thing
-               ; type_env = mkTypeEnv (concatMap add_implicits ty_things) }
+
+               -- Load & typecheck the decls
+       ; decl_things <- loadDecls ignore_prags (mi_decls iface)
+
+       ; let type_env = mkNameEnv decl_things
        ; writeMutVar tc_env_var type_env
 
                -- Now do those rules and instances
+       ; let { rules | ignore_prags = []
+                     | otherwise    = mi_rules iface
+             ; dfuns = mi_insts iface
+             } 
        ; dfuns <- mapM tcIfaceInst dfuns
        ; rules <- mapM tcIfaceRule rules
 

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 9489388..f0f60f7 100644 (file)
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -381,11 +381,11 @@ dynamic_flags = [
   ,  ( "ddump-rules",           setDumpFlag Opt_D_dump_rules)
   ,  ( "ddump-cse",             setDumpFlag Opt_D_dump_cse)
   ,  ( "ddump-worker-wrapper",   setDumpFlag Opt_D_dump_worker_wrapper)
-  ,  ( "ddump-rn-trace",         setDumpFlag Opt_D_dump_rn_trace)
-  ,  ( "ddump-if-trace",         setDumpFlag Opt_D_dump_if_trace)
+  ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace))
+  ,  ( "ddump-if-trace",         NoArg (setDynFlag Opt_D_dump_if_trace))
   ,  ( "ddump-tc-trace",         setDumpFlag Opt_D_dump_tc_trace)
   ,  ( "ddump-splices",          setDumpFlag Opt_D_dump_splices)
-  ,  ( "ddump-rn-stats",         setDumpFlag Opt_D_dump_rn_stats)
+  ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats))
   ,  ( "ddump-opt-cmm",          setDumpFlag Opt_D_dump_opt_cmm)
   ,  ( "ddump-simpl-stats",      setDumpFlag Opt_D_dump_simpl_stats)
   ,  ( "ddump-bcos",             setDumpFlag Opt_D_dump_BCOs)