FIX #2845: Allow breakpoints on expressions with unlifted type

It turns out we can easily support breakpoints on expressions with
unlifted types, by translating 

  case tick# of _ -> e

into

  let f = \s . case tick# of _ -> e 
  in  f realWorld#

instead of just a plain let-binding.  This is the same trick that GHC
uses for abstracting join points of unlifted type.

In #2845, GHC has eta-expanded the tick expression, changing the
result type from IO a to (# State#, a #), which was the reason the
tick was suddenly being ignored.  By supporting ticks on unlifted
expressions we can make it work again, although some confusion might
arise because _result will no longer be available (it now has
unboxed-tuple type, so we can't bind it in the environment).  The
underlying problem here is that GHC does transformations like
eta-expanding the tick expressions, and there's nothing we can do to
prevent that.

1 files changed, 15 insertions, 2 deletions

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 95aae77671..888aeec739 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -17,6 +17,7 @@ import LibFFI
 
 import Outputable
 import Name
+import MkId
 import Id
 import FiniteMap
 import ForeignCall
@@ -454,9 +455,21 @@ schemeE d s p (AnnLet binds (_,body))
 -- best way to calculate the free vars but it seemed like the least
 -- intrusive thing to do
 schemeE d s p exp@(AnnCase {})
-   | Just (_tickInfo, rhs) <- isTickedExp' exp
+   | Just (_tickInfo, _rhs) <- isTickedExp' exp
    = if isUnLiftedType ty
-        then schemeE d s p (snd rhs)
+        then do
+          -- If the result type is unlifted, then we must generate
+          --   let f = \s . case tick# of _ -> e 
+          --   in  f realWorld#
+          -- When we stop at the breakpoint, _result will have an unlifted
+          -- type and hence won't be bound in the environment, but the
+          -- breakpoint will otherwise work fine.
+          id <- newId (mkFunTy realWorldStatePrimTy ty)
+          st <- newId realWorldStatePrimTy
+          let letExp = AnnLet (AnnNonRec id (fvs, AnnLam st (emptyVarSet, exp)))
+                              (emptyVarSet, (AnnApp (emptyVarSet, AnnVar id) 
+                                                    (emptyVarSet, AnnVar realWorldPrimId)))
+          schemeE d s p letExp
         else do
           id <- newId ty
           -- Todo: is emptyVarSet correct on the next line?