diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2019-08-19 10:03:35 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2019-08-21 06:36:27 -0400 |
| commit | a2a0e6f3bb2d02a9347dec4c7c4f6d4480bc2421 (patch) | |
| tree | fa66e8c7f5e9c0b7ee6aafb4b953478374c4ea8f | |
| parent | 6bd8b6d1adb61ef3e49b61cf503409fbb9081b50 (diff) | |
| download | haskell-a2a0e6f3bb2d02a9347dec4c7c4f6d4480bc2421.tar.gz | |
SetLevels: Don't set context level when floating cases
When floating a single-alternative case we previously would set the
context level to the level where we were floating the case. However,
this is not what FloatOut did: it rather left
| -rw-r--r-- | compiler/simplCore/SetLevels.hs | 6 |
1 files changed, 2 insertions, 4 deletions
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 54d9315a7e..3192c3bef1 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -504,7 +504,7 @@ Consider this: Here we can float the (case y ...) out, because y is sure to be evaluated, to give f x vs = case x of { MkT y -> - caes y of I# w -> + case y of I# w -> let f vs = ...(e)...f.. in f vs @@ -1674,9 +1674,7 @@ cloneCaseBndrs env@(LE { le_subst = subst, le_lvl_env = lvl_env, le_env = id_env new_lvl vs = do { us <- getUniqueSupplyM ; let (subst', vs') = cloneBndrs subst us vs - env' = env { le_ctxt_lvl = new_lvl - , le_join_ceil = new_lvl - , le_lvl_env = addLvls new_lvl lvl_env vs' + env' = env { le_lvl_env = addLvls new_lvl lvl_env vs' , le_subst = subst' , le_env = foldl' add_id id_env (vs `zip` vs') } |