X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FByteCodeGen.lhs;h=f526ed990789de279838dd866172f648ebb1e9d2;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=a4dd7ceac93be1d5ab3f7d60c89d657f62d0e7a6;hpb=853e20a3eb86137cdb8accf69c6caa9db83a3d34;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
index a4dd7ce..f526ed9 100644
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ b/ghc/compiler/ghci/ByteCodeGen.lhs
@@ -30,8 +30,8 @@ import Type		( isUnLiftedType, splitTyConApp_maybe )
 import DataCon		( DataCon, dataConTag, fIRST_TAG, dataConTyCon, 
                           isUnboxedTupleCon, isNullaryRepDataCon, dataConWorkId,
 			  dataConRepArity )
-import TyCon		( tyConFamilySize, isDataTyCon, tyConDataCons,
-			  isUnboxedTupleTyCon )
+import TyCon		( TyCon, tyConFamilySize, isDataTyCon, 
+			  tyConDataCons, isUnboxedTupleTyCon )
 import Class		( Class, classTyCon )
 import Type		( Type, repType, splitFunTys, dropForAlls, pprType )
 import Util
@@ -53,7 +53,8 @@ import OrdList
 import Constants	( wORD_SIZE )
 
 import Data.List	( intersperse, sortBy, zip4, zip5, partition )
-import Foreign		( Ptr, castPtr, mallocBytes, pokeByteOff, Word8 )
+import Foreign		( Ptr, castPtr, mallocBytes, pokeByteOff, Word8,
+			  withForeignPtr )
 import Foreign.C	( CInt )
 import Control.Exception	( throwDyn )
 
@@ -67,13 +68,10 @@ import Data.Char	( ord, chr )
 
 byteCodeGen :: DynFlags
             -> [CoreBind]
-	    -> TypeEnv
+	    -> [TyCon]
             -> IO CompiledByteCode
-byteCodeGen dflags binds type_env
+byteCodeGen dflags binds tycs
    = do showPass dflags "ByteCodeGen"
-        let  local_tycons  = typeEnvTyCons  type_env
-	     local_classes = typeEnvClasses type_env
-	     tycs = local_tycons ++ map classTyCon local_classes
 
         let flatBinds = [ (bndr, freeVars rhs) 
 			| (bndr, rhs) <- flattenBinds binds]
@@ -1087,18 +1085,18 @@ pushAtom d p (AnnLit lit)
         pushStr s 
            = let getMallocvilleAddr
                     = case s of
-                         FastString _ l ba -> 
-                            -- sigh, a string in the heap is no good to us.
-                            -- We need a static C pointer, since the type of 
-                            -- a string literal is Addr#.  So, copy the string 
-                            -- into C land and remember the pointer so we can
-			    -- free it later.
-                            let n = I# l
-                            -- CAREFUL!  Chars are 32 bits in ghc 4.09+
-                            in  ioToBc (mallocBytes (n+1)) `thenBc` \ ptr ->
+                         FastString _ n _ fp _ -> 
+			    -- we could grab the Ptr from the ForeignPtr,
+			    -- but then we have no way to control its lifetime.
+			    -- In reality it'll probably stay alive long enoungh
+			    -- by virtue of the global FastString table, but
+			    -- to be on the safe side we copy the string into
+			    -- a malloc'd area of memory.
+                                ioToBc (mallocBytes (n+1)) `thenBc` \ ptr ->
                                 recordMallocBc ptr         `thenBc_`
                                 ioToBc (
-                                   do memcpy ptr ba (fromIntegral n)
+                                   withForeignPtr fp $ \p -> do
+				      memcpy ptr p (fromIntegral n)
 				      pokeByteOff ptr n (fromIntegral (ord '\0') :: Word8)
                                       return ptr
                                    )
@@ -1113,7 +1111,7 @@ pushAtom d p other
               (pprCoreExpr (deAnnotate (undefined, other)))
 
 foreign import ccall unsafe "memcpy"
- memcpy :: Ptr a -> ByteArray# -> CInt -> IO ()
+ memcpy :: Ptr a -> Ptr b -> CInt -> IO ()
 
 
 -- -----------------------------------------------------------------------------