[commit: ghc] master: Levity polymorphic expressions mustn't be floated-out in let-bindings. (514c01e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/514c01eec5f2b23f278c29b61345dce6c37900f1/ghc

>---------------------------------------------------------------

commit 514c01eec5f2b23f278c29b61345dce6c37900f1
Author: Sylvain Henry <sylvain at haskus.fr>
Date:   Thu Dec 1 12:24:34 2016 -0500

    Levity polymorphic expressions mustn't be floated-out in let-bindings.
    
    Reviewers: simonpj, austin, bgamari
    
    Reviewed By: simonpj, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2769
    
    GHC Trac Issues: #12901


>---------------------------------------------------------------

514c01eec5f2b23f278c29b61345dce6c37900f1
 compiler/simplCore/SetLevels.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index f2f373d..dc36a6c 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -83,6 +83,7 @@ import Demand           ( StrictSig )
 import Name             ( getOccName, mkSystemVarName )
 import OccName          ( occNameString )
 import Type             ( isUnliftedType, Type, mkLamTypes )
+import Kind             ( isLevityPolymorphic, typeKind )
 import BasicTypes       ( Arity, RecFlag(..) )
 import UniqSupply
 import Util
@@ -487,6 +488,9 @@ lvlMFE strict_ctxt env ann_expr
          -- Can't let-bind it; see Note [Unlifted MFEs]
          -- This includes coercions, which we don't want to float anyway
          -- NB: no need to substitute cos isUnliftedType doesn't change
+  || isLevityPolymorphic (typeKind (exprType expr))
+         -- We can't let-bind levity polymorphic expressions
+         -- See Note [Levity polymorphism invariants] in CoreSyn
   || notWorthFloating ann_expr abs_vars
   || not float_me
   =     -- Don't float it out