``Long-distance'' floating of bindings towards the top level.
\begin{code}
-#include "HsVersions.h"
-
module FloatOut ( floatOutwards ) where
-import Ubiq{-uitous-}
+#include "HsVersions.h"
import CoreSyn
import CmdLineOpts ( opt_D_verbose_core2core, opt_D_simplifier_stats )
-import CostCentre ( dupifyCC )
-import Id ( nullIdEnv, addOneToIdEnv, growIdEnvList, IdEnv(..),
- GenId{-instance Outputable-}
+import CostCentre ( dupifyCC, CostCentre )
+import Id ( nullIdEnv, addOneToIdEnv, growIdEnvList, IdEnv,
+ GenId{-instance Outputable-}, Id
)
-import Outputable ( Outputable(..){-instance (,)-} )
-import PprCore ( GenCoreBinding{-instance-} )
-import PprStyle ( PprStyle(..) )
-import PprType -- too lazy to type in all the instances
-import Pretty ( ppInt, ppStr, ppBesides, ppAboves )
+import PprCore
+import PprType ( GenTyVar )
import SetLevels -- all of it
-import TyVar ( GenTyVar{-instance Eq-} )
+import BasicTypes ( Unused )
+import TyVar ( GenTyVar{-instance Eq-}, TyVar )
import Unique ( Unique{-instance Eq-} )
-import Usage ( UVar(..) )
-import Util ( pprTrace, panic )
+import UniqSupply ( UniqSupply )
+import List ( partition )
+import Outputable
\end{code}
Random comments
Well, maybe. We don't do this at the moment.
\begin{code}
-type LevelledExpr = GenCoreExpr (Id, Level) Id TyVar UVar
-type LevelledBind = GenCoreBinding (Id, Level) Id TyVar UVar
+type LevelledExpr = GenCoreExpr (Id, Level) Id Unused
+type LevelledBind = GenCoreBinding (Id, Level) Id Unused
type FloatingBind = (Level, Floater)
type FloatingBinds = [FloatingBind]
(if opt_D_verbose_core2core
then pprTrace "Levels added:\n"
- (ppAboves (map (ppr PprDebug) annotated_w_levels))
+ (vcat (map (ppr) annotated_w_levels))
else id
)
( if not (opt_D_simplifier_stats) then
let
(tlets, ntlets, lams) = get_stats (sum_stats fss)
in
- pprTrace "FloatOut stats: " (ppBesides [
- ppInt tlets, ppStr " Lets floated to top level; ",
- ppInt ntlets, ppStr " Lets floated elsewhere; from ",
- ppInt lams, ppStr " Lambda groups"])
+ pprTrace "FloatOut stats: " (hcat [
+ int tlets, ptext SLIT(" Lets floated to top level; "),
+ int ntlets, ptext SLIT(" Lets floated elsewhere; from "),
+ int lams, ptext SLIT(" Lambda groups")])
)
concat final_toplev_binds_s
}}
= case (floatExpr env lvl e) of { (fs, floating_defns, e') ->
(fs, floating_defns, App e' a) }
-floatExpr env lvl (Lam (UsageBinder _) e)
- = panic "FloatOut.floatExpr: Lam UsageBinder"
-
floatExpr env lvl (Lam (TyBinder tv) e)
= let
incd_lvl = incMinorLvl lvl