X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=8c99fcb1a421504c878b5230057b860195855b5d;hb=02ec37666737ddca8d59ad4ba89ca8b0f12244e2;hp=2945a7c7e407c3dbe51c60bed6a494b56225a459;hpb=63e3a41126771e71c44705480c2bde7043a41df3;p=ghc-hetmet.git diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 2945a7c..8c99fcb 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -449,7 +449,7 @@ notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool -- abs_vars = tvars only: return True if e is trivial, -- but False for anything bigger -- abs_vars = [x] (an Id): return True for trivial, or an application (f x) --- but False for (f x x) +-- but False for (f x x) -- -- One big goal is that floating should be idempotent. Eg if -- we replace e with (lvl79 x y) and then run FloatOut again, don't want @@ -458,8 +458,8 @@ notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool notWorthFloating e abs_vars = go e (count isId abs_vars) where - go (_, AnnVar {}) n = n == 0 - go (_, AnnLit {}) n = n == 0 + go (_, AnnVar {}) n = n >= 0 + go (_, AnnLit {}) n = n >= 0 go (_, AnnCast e _) n = go e n go (_, AnnApp e arg) n | (_, AnnType {}) <- arg = go e n @@ -615,7 +615,7 @@ lvlBind top_lvl ctxt_lvl env (AnnRec pairs) abs_vars = abstractVars dest_lvl env bind_fvs ---------------------------------------------------- --- Three help functons for the type-abstraction case +-- Three help functions for the type-abstraction case lvlFloatRhs :: [CoreBndr] -> Level -> LevelEnv -> CoreExprWithFVs -> UniqSM (Expr (TaggedBndr Level))