Trim unused imports detected by new unused-import code

[ghc-hetmet.git] / compiler / ghci / ByteCodeGen.lhs

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index a9e3c07..0df09d6 100644 (file)
--- 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