[project @ 2005-06-21 11:57:00 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / TidyPgm.lhs
index 0af2ca7..62a2c82 100644 (file)
@@ -8,7 +8,8 @@ module TidyPgm( mkBootModDetails, tidyProgram ) where
 
 #include "HsVersions.h"
 
-import DynFlags        ( DynFlags, DynFlag(..), dopt )
+import DynFlags                ( DynFlag(..), dopt )
+import Packages                ( HomeModules )
 import CoreSyn
 import CoreUnfold      ( noUnfolding, mkTopUnfolding )
 import CoreFVs         ( ruleLhsFreeIds, exprSomeFreeVars )
@@ -256,7 +257,7 @@ tidyProgram hsc_env
                -- (It's a sort of mutual recursion.)
        }
 
-       ; (tidy_env, tidy_binds) <- tidyTopBinds hsc_env mod type_env ext_ids binds
+       ; (tidy_env, tidy_binds) <- tidyTopBinds hsc_env home_mods mod type_env ext_ids binds
 
        ; let { tidy_type_env = tidyTypeEnv omit_prags exports type_env tidy_binds
              ; tidy_ispecs   = tidyInstances (lookup_dfun tidy_type_env) insts_tc
@@ -527,6 +528,7 @@ findExternalRules binds non_local_rules ext_ids
 --   * subst_env: A Var->Var mapping that substitutes the new Var for the old
 
 tidyTopBinds :: HscEnv
+            -> HomeModules
             -> Module
             -> TypeEnv
             -> IdEnv Bool      -- Domain = Ids that should be external
@@ -534,10 +536,9 @@ tidyTopBinds :: HscEnv
             -> [CoreBind]
             -> IO (TidyEnv, [CoreBind])
 
-tidyTopBinds hsc_env mod type_env ext_ids binds
+tidyTopBinds hsc_env hmods mod type_env ext_ids binds
   = tidy init_env binds
   where
-    dflags = hsc_dflags hsc_env
     nc_var = hsc_NC hsc_env 
 
        -- We also make sure to avoid any exported binders.  Consider
@@ -560,12 +561,12 @@ tidyTopBinds hsc_env mod type_env ext_ids binds
                -- The type environment is a convenient source of such things.
 
     tidy env []     = return (env, [])
-    tidy env (b:bs) = do { (env1, b')  <- tidyTopBind dflags mod nc_var ext_ids env b
+    tidy env (b:bs) = do { (env1, b')  <- tidyTopBind hmods mod nc_var ext_ids env b
                         ; (env2, bs') <- tidy env1 bs
                         ; return (env2, b':bs') }
 
 ------------------------
-tidyTopBind  :: DynFlags
+tidyTopBind  :: HomeModules
             -> Module
             -> IORef NameCache -- For allocating new unique names
             -> IdEnv Bool      -- Domain = Ids that should be external
@@ -573,16 +574,16 @@ tidyTopBind  :: DynFlags
             -> TidyEnv -> CoreBind
             -> IO (TidyEnv, CoreBind)
 
-tidyTopBind dflags mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (NonRec bndr rhs)
+tidyTopBind hmods mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (NonRec bndr rhs)
   = do { (occ_env2, name') <- tidyTopName mod nc_var ext_ids occ_env1 bndr
        ; let   { (bndr', rhs') = tidyTopPair ext_ids tidy_env2 caf_info name' (bndr, rhs)
                ; subst2        = extendVarEnv subst1 bndr bndr'
                ; tidy_env2     = (occ_env2, subst2) }
        ; return (tidy_env2, NonRec bndr' rhs') }
   where
-    caf_info = hasCafRefs dflags subst1 (idArity bndr) rhs
+    caf_info = hasCafRefs hmods subst1 (idArity bndr) rhs
 
-tidyTopBind dflags mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (Rec prs)
+tidyTopBind hmods mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (Rec prs)
   = do { (occ_env2, names') <- tidyTopNames mod nc_var ext_ids occ_env1 bndrs
        ; let   { prs'      = zipWith (tidyTopPair ext_ids tidy_env2 caf_info)
                                      names' prs
@@ -595,7 +596,7 @@ tidyTopBind dflags mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (Rec prs)
        -- the CafInfo for a recursive group says whether *any* rhs in
        -- the group may refer indirectly to a CAF (because then, they all do).
     caf_info 
-       | or [ mayHaveCafRefs (hasCafRefs dflags subst1 (idArity bndr) rhs)
+       | or [ mayHaveCafRefs (hasCafRefs hmods subst1 (idArity bndr) rhs)
             | (bndr,rhs) <- prs ] = MayHaveCafRefs
        | otherwise                = NoCafRefs
 
@@ -771,13 +772,13 @@ it as a CAF.  In these cases however, we would need to use an additional
 CAF list to keep track of non-collectable CAFs.  
 
 \begin{code}
-hasCafRefs  :: DynFlags -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
-hasCafRefs dflags p arity expr 
+hasCafRefs  :: HomeModules -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
+hasCafRefs hmods p arity expr 
   | is_caf || mentions_cafs = MayHaveCafRefs
   | otherwise              = NoCafRefs
  where
   mentions_cafs = isFastTrue (cafRefs p expr)
-  is_caf = not (arity > 0 || rhsIsStatic dflags expr)
+  is_caf = not (arity > 0 || rhsIsStatic hmods expr)
   -- NB. we pass in the arity of the expression, which is expected
   -- to be calculated by exprArity.  This is because exprArity
   -- knows how much eta expansion is going to be done by