[project @ 2003-03-31 13:08:49 by simonmar]

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

diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
index d8bb406..d5dca0e 100644 (file)
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ b/ghc/compiler/ghci/ByteCodeGen.lhs
@@ -19,7 +19,8 @@ import Name           ( Name, getName, mkSystemName )
 import Id
 import FiniteMap
 import ForeignCall     ( ForeignCall(..), CCallTarget(..), CCallSpec(..) )
-import HscTypes                ( ModGuts(..), ModGuts, typeEnvTyCons, typeEnvClasses )
+import HscTypes                ( ModGuts(..), ModGuts, 
+                         TypeEnv, typeEnvTyCons, typeEnvClasses )
 import CoreUtils       ( exprType )
 import CoreSyn
 import PprCore         ( pprCoreExpr )
@@ -71,9 +72,10 @@ import Data.Bits
 -- Generating byte code for a complete module 
 
 byteCodeGen :: DynFlags
-            -> ModGuts
+            -> [CoreBind]
+           -> TypeEnv
             -> IO CompiledByteCode
-byteCodeGen dflags (ModGuts { mg_binds = binds, mg_types = type_env })
+byteCodeGen dflags binds type_env
    = do showPass dflags "ByteCodeGen"
         let  local_tycons  = typeEnvTyCons  type_env
             local_classes = typeEnvClasses type_env
@@ -378,8 +380,8 @@ schemeE d s p (AnnLet binds (_,body))
 
          fvss  = map (fvsToEnv p' . fst) rhss
 
-         -- Sizes of free vars, + 1 for the fn
-         sizes = map (\rhs_fvs -> 1 + sum (map idSizeW rhs_fvs)) fvss
+         -- Sizes of free vars
+         sizes = map (\rhs_fvs -> sum (map idSizeW rhs_fvs)) fvss
 
         -- the arity of each rhs
         arities = map (length . fst . collect []) rhss
@@ -395,7 +397,7 @@ schemeE d s p (AnnLet binds (_,body))
          -- ToDo: don't build thunks for things with no free variables
          build_thunk dd [] size bco off
             = returnBc (PUSH_BCO bco
-                        `consOL` unitOL (MKAP (off+size-1) size))
+                        `consOL` unitOL (MKAP (off+size) size))
          build_thunk dd (fv:fvs) size bco off = do
               (push_code, pushed_szw) <- pushAtom dd p' (AnnVar fv) 
               more_push_code <- build_thunk (dd+pushed_szw) fvs size bco off
@@ -1107,13 +1109,13 @@ pushAtom d p (AnnVar v)
 
 pushAtom d p (AnnLit lit)
    = case lit of
-        MachLabel fs -> code CodePtrRep
-        MachWord w   -> code WordRep
-        MachInt i    -> code IntRep
-        MachFloat r  -> code FloatRep
-        MachDouble r -> code DoubleRep
-        MachChar c   -> code CharRep
-        MachStr s    -> pushStr s
+        MachLabel fs _ -> code CodePtrRep
+        MachWord w     -> code WordRep
+        MachInt i      -> code IntRep
+        MachFloat r    -> code FloatRep
+        MachDouble r   -> code DoubleRep
+        MachChar c     -> code CharRep
+        MachStr s      -> pushStr s
      where
         code rep
            = let size_host_words = getPrimRepSize rep