X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FBufWrite.hs;h=b15089ead375192d4307068edc9b372ed0f02e90;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=6d00e46634f85149768ec6292fa659d315b35558;hpb=ac88f113abdec1edbffb6d2f97323e81f82908e7;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/BufWrite.hs b/ghc/compiler/utils/BufWrite.hs
index 6d00e46..b15089e 100644
--- a/ghc/compiler/utils/BufWrite.hs
+++ b/ghc/compiler/utils/BufWrite.hs
@@ -31,17 +31,11 @@ import Char		( ord )
 import Foreign
 import IO
 
-#if __GLASGOW_HASKELL__ < 503
-import PrelIOBase	( IO(..) )
-import IOExts		( hPutBufFull )
-#else
 import GHC.IOBase	( IO(..) )
 import System.IO	( hPutBuf )
-#endif
-
-import GLAEXTS		( touch#, byteArrayContents#, Int(..), Int#, Addr# )
+import GHC.Ptr		( Ptr(..) )
 
-import PrimPacked	( Ptr(..) )
+import GLAEXTS		( Int(..), Int#, Addr# )
 
 -- -----------------------------------------------------------------------------
 
@@ -88,22 +82,17 @@ bPutStr b@(BufHandle buf r hdl) str = do
 		loop cs (i+1)
   
 bPutFS :: BufHandle -> FastString -> IO ()
-bPutFS b@(BufHandle buf r hdl) fs@(FastString _ len# arr#) = do
-  let len = I# len#
+bPutFS b@(BufHandle buf r hdl) fs@(FastString _ len _ fp _) =
+ withForeignPtr fp $ \ptr -> do
   i <- readFastMutInt r
   if (i + len) >= buf_size
 	then do hPutBuf hdl buf i
 		writeFastMutInt r 0
 		if (len >= buf_size) 
-		    then do
-			 let a# = byteArrayContents# arr#
-			 hPutBuf hdl (Ptr a#) len
-			 touch fs
+		    then hPutBuf hdl ptr len
 		    else bPutFS b fs
 	else do
-		let a# = byteArrayContents# arr#
-		copyBytes (buf `plusPtr` i) (Ptr a#) len
-		touch fs
+		copyBytes (buf `plusPtr` i) ptr len
 		writeFastMutInt r (i+len)
 bPutFS _ _ = panic "bPutFS"
 
@@ -128,8 +117,6 @@ bFlush b@(BufHandle buf r hdl) = do
   free buf
   return ()
 
-touch r = IO $ \s -> case touch# r s of s -> (# s, () #)
-
 #if 0
 myPutBuf s hdl buf i = 
   modifyIOError (\e -> ioeSetErrorString e (ioeGetErrorString e ++ ':':s ++ " (" ++ show buf ++ "," ++ show i ++ ")")) $