``Long-distance'' floating of bindings towards the top level.
\begin{code}
-#include "HsVersions.h"
-
module FloatOut ( floatOutwards ) where
-IMP_Ubiq(){-uitous-}
-IMPORT_1_3(List(partition))
+#include "HsVersions.h"
import CoreSyn
import CmdLineOpts ( opt_D_verbose_core2core, opt_D_simplifier_stats )
-import CostCentre ( dupifyCC )
-import Id ( nullIdEnv, addOneToIdEnv, growIdEnvList, SYN_IE(IdEnv),
- GenId{-instance Outputable-}
+import CostCentre ( dupifyCC, CostCentre )
+import Id ( nullIdEnv, addOneToIdEnv, growIdEnvList, IdEnv,
+ GenId{-instance Outputable-}, Id
)
-import Outputable ( Outputable(..){-instance (,)-} )
import PprCore
-import PprStyle ( PprStyle(..) )
import PprType ( GenTyVar )
-import Pretty ( ppInt, ppPStr, ppBesides, ppAboves )
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 ( SYN_IE(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, ppPStr SLIT(" Lets floated to top level; "),
- ppInt ntlets, ppPStr SLIT(" Lets floated elsewhere; from "),
- ppInt lams, ppPStr SLIT(" 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