[project @ 2001-07-24 04:47:06 by ken]
[ghc-hetmet.git] / ghc / compiler / simplCore / FloatOut.lhs
index 8e99776..0160906 100644 (file)
@@ -16,14 +16,12 @@ import CoreUtils    ( mkSCC )
 import CmdLineOpts     ( DynFlags, DynFlag(..), dopt )
 import ErrUtils                ( dumpIfSet_dyn )
 import CostCentre      ( dupifyCC, CostCentre )
-import Id              ( Id, idType )
+import Id              ( Id )
 import VarEnv
-import CoreLint                ( beginPass, endPass )
+import CoreLint                ( showPass, endPass )
 import SetLevels       ( setLevels,
                          Level(..), tOP_LEVEL, ltMajLvl, ltLvl, isTopLvl
                        )
-import Type            ( isUnLiftedType )
-import Var             ( TyVar )
 import UniqSupply       ( UniqSupply )
 import List            ( partition )
 import Outputable
@@ -82,7 +80,7 @@ floatOutwards :: DynFlags
 
 floatOutwards dflags float_lams us pgm
   = do {
-       beginPass dflags float_msg ;
+       showPass dflags float_msg ;
 
        let { annotated_w_levels = setLevels float_lams pgm us ;
              (fss, binds_s')    = unzip (map floatTopBind annotated_w_levels)
@@ -98,10 +96,8 @@ floatOutwards dflags float_lams us pgm
                        int ntlets, ptext SLIT(" Lets floated elsewhere; from "),
                        int lams,   ptext SLIT(" Lambda groups")]);
 
-       endPass dflags float_msg
-               (dopt Opt_D_verbose_core2core dflags)
+       endPass dflags float_msg  Opt_D_verbose_core2core (concat binds_s')
                        {- no specific flag for dumping float-out -} 
-               (concat binds_s')
     }
   where
     float_msg | float_lams = "Float out (floating lambdas too)"