[commit: ghc] : SetLevels: Do not float nullary data constructors (32a2826)
git at git.haskell.org
git at git.haskell.org
Mon Oct 10 21:43:52 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch :
Link : http://ghc.haskell.org/trac/ghc/changeset/32a2826823c67b8ff54224b47ede9017619a7a23/ghc
>---------------------------------------------------------------
commit 32a2826823c67b8ff54224b47ede9017619a7a23
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Sun Oct 9 15:51:04 2016 -0400
SetLevels: Do not float nullary data constructors
>---------------------------------------------------------------
32a2826823c67b8ff54224b47ede9017619a7a23
compiler/simplCore/SetLevels.hs | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index 6a0c723..0d1ad99 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -617,11 +617,12 @@ notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool
notWorthFloating e abs_vars
= go e (count isId abs_vars)
where
- go (_, AnnVar {}) n = n >= 0
- go (_, AnnLit lit) n = ASSERT( n==0 )
- litIsTrivial lit -- Note [Floating literals]
- go (_, AnnTick t e) n = not (tickishIsCode t) && go e n
- go (_, AnnCast e _) n = go e n
+ go (_, AnnVar {}) n = n >= 0
+ go (_, AnnConApp _ args) _ = all isAnnTypeArg args
+ go (_, AnnLit lit) n = ASSERT( n==0 )
+ litIsTrivial lit -- Note [Floating literals]
+ go (_, AnnTick t e) n = not (tickishIsCode t) && go e n
+ go (_, AnnCast e _) n = go e n
go (_, AnnApp e arg) n
| (_, AnnType {}) <- arg = go e n
| (_, AnnCoercion {}) <- arg = go e n
@@ -634,6 +635,7 @@ notWorthFloating e abs_vars
is_triv (_, AnnVar {}) = True -- (ie not worth floating)
is_triv (_, AnnCast e _) = is_triv e
is_triv (_, AnnApp e (_, AnnType {})) = is_triv e
+ is_triv (_, AnnConApp _ args) = all isAnnTypeArg args
is_triv (_, AnnApp e (_, AnnCoercion {})) = is_triv e
is_triv (_, AnnTick t e) = not (tickishIsCode t) && is_triv e
is_triv _ = False
More information about the ghc-commits
mailing list