diff options
| author | simonpj@microsoft.com <unknown> | 2010-08-13 16:14:29 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2010-08-13 16:14:29 +0000 |
| commit | ff094439a92e505927739fdbdcc42904d9920892 (patch) | |
| tree | 810b5e2efadf2a63f8ca602a506dfb3f706b08c4 /compiler/simplCore | |
| parent | 1caf694c7d5ea3699cfb988b25f0c850cedcd3e4 (diff) | |
| download | haskell-ff094439a92e505927739fdbdcc42904d9920892.tar.gz | |
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.
Diffstat (limited to 'compiler/simplCore')
| -rw-r--r-- | compiler/simplCore/SetLevels.lhs | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 2945a7c7e4..8c99fcb1a4 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)) |