X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=0df09d63d3bcfedd52a466e81ecfe503c1d2708e;hp=a9e3c07524158f17ae055e67e01d266906547738;hb=d436c70d43fb905c63220040168295e473f4b90a;hpb=85f8276b368d39c93e137fa7b0a8a96ab3c6b389

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index a9e3c07..0df09d6 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
@@ -30,9 +31,9 @@ import CoreFVs
 import Type
 import DataCon
 import TyCon
-import Type
+-- import Type
 import Util
-import DataCon
+-- import DataCon
 import Var
 import VarSet
 import TysPrim
@@ -50,7 +51,7 @@ import Data.List
 import Foreign
 import Foreign.C
 
-import GHC.Exts		( Int(..), ByteArray# )
+-- import GHC.Exts		( Int(..) )
 
 import Control.Monad	( when )
 import Data.Char
@@ -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?
@@ -1205,7 +1218,7 @@ pushAtom d p (AnnVar v)
 
 pushAtom _ _ (AnnLit lit)
    = case lit of
-        MachLabel _ _ -> code NonPtrArg
+        MachLabel _ _ _ -> code NonPtrArg
         MachWord _    -> code NonPtrArg
         MachInt _     -> code PtrArg
         MachFloat _   -> code FloatArg