From ff9ab413f6ea513f1aea29c987805d022b72109a Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 21 Feb 2005 14:07:08 +0000 Subject: [PATCH] [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. --- ghc/compiler/iface/LoadIface.lhs | 30 ++++++++++++++++++++++-------- ghc/compiler/iface/TcIface.lhs | 33 +++++++++++---------------------- ghc/compiler/main/DriverFlags.hs | 6 +++--- 3 files changed, 36 insertions(+), 33 deletions(-) diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs index b63849d..e5e7a5a 100644 --- 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 --- 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 --- 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) -- 1.7.10.4