Make the new binder-swap stuff in OccurAnal work right for GlobalIds

[ghc-hetmet.git] / compiler / simplCore / SetLevels.lhs

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index f5a5a26..2c84589 100644 (file)
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -358,7 +358,8 @@ lvlExpr ctxt_lvl env (_, AnnCase expr case_bndr ty alts) = do
 @lvlMFE@ is just like @lvlExpr@, except that it might let-bind
 the expression, so that it can itself be floated.
 
-[NOTE: unlifted MFEs]
+Note [Unlifted MFEs]
+~~~~~~~~~~~~~~~~~~~~~
 We don't float unlifted MFEs, which potentially loses big opportunites.
 For example:
        \x -> f (h y)
@@ -377,7 +378,7 @@ lvlMFE _ _ _ (_, AnnType ty)
 
 
 lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
-  |  isUnLiftedType ty                 -- Can't let-bind it; see [NOTE: unlifted MFEs]
+  |  isUnLiftedType ty                 -- Can't let-bind it; see Note [Unlifted MFEs]
   || isInlineCtxt ctxt_lvl             -- Don't float out of an __inline__ context
   || exprIsTrivial expr                        -- Never float if it's trivial
   || not good_destination
@@ -481,7 +482,9 @@ lvlBind :: TopLevelFlag             -- Used solely to decide whether to clone
        -> LvlM (LevelledBind, LevelEnv)
 
 lvlBind top_lvl ctxt_lvl env (AnnNonRec bndr rhs@(rhs_fvs,_))
-  | isInlineCtxt ctxt_lvl              -- Don't do anything inside InlineMe
+  |  isTyVar bndr              -- Don't do anything for TyVar binders
+                               --   (simplifier gets rid of them pronto)
+  || isInlineCtxt ctxt_lvl     -- Don't do anything inside InlineMe
   = do rhs' <- lvlExpr ctxt_lvl env rhs
        return (NonRec (TB bndr ctxt_lvl) rhs', env)