From ff094439a92e505927739fdbdcc42904d9920892 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Fri, 13 Aug 2010 16:14:29 +0000 Subject: [PATCH] Fix egregious bug in SetLevels.notWorthFloating This bug just led to stupid code, which would later be optimised away, but better not to generate stupid code in the first place. --- compiler/simplCore/SetLevels.lhs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) 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)) -- 1.7.10.4