[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