X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=888aeec73910225c4f41388d505e0acd0093e9cc;hb=035890658d56bc5233f73b311a1bd08c41752d33;hp=95aae77671a03aa8d946d07daa2b453951882c43;hpb=497302c44ad08c6c27d0e15d94a787f332c0cfec;p=ghc-hetmet.git

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 95aae77..888aeec 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?