X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FBufWrite.hs;h=306413573f322f0c9bbcf80a71d0d0b03bf4ebe9;hp=140d4b2367c5889016303dd044f6abdcf1692872;hb=d0faaa6fa0cecd23c5670fd199e9206275313666;hpb=982c1f494de8a691294a95aee108e765c3f592a0 diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index 140d4b2..3064135 100644 --- a/compiler/utils/BufWrite.hs +++ b/compiler/utils/BufWrite.hs @@ -1,10 +1,3 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - ----------------------------------------------------------------------------- -- -- Fast write-buffered Handles @@ -30,6 +23,7 @@ module BufWrite ( #include "HsVersions.h" import FastString +import FastTypes import FastMutInt import Control.Monad ( when ) @@ -37,11 +31,6 @@ import Data.Char ( ord ) import Foreign import System.IO -import GHC.IOBase ( IO(..) ) -import GHC.Ptr ( Ptr(..) ) - -import GHC.Exts ( Int(..), Int#, Addr# ) - -- ----------------------------------------------------------------------------- data BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8) @@ -55,7 +44,8 @@ newBufHandle hdl = do writeFastMutInt r 0 return (BufHandle ptr r hdl) -buf_size = 8192 :: Int +buf_size :: Int +buf_size = 8192 #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined @@ -73,7 +63,7 @@ bPutChar b@(BufHandle buf r hdl) c = do bPutStr :: BufHandle -> String -> IO () STRICT2(bPutStr) -bPutStr b@(BufHandle buf r hdl) str = do +bPutStr (BufHandle buf r hdl) str = do i <- readFastMutInt r loop str i where loop _ i | i `seq` False = undefined @@ -100,22 +90,22 @@ bPutFS b@(BufHandle buf r hdl) fs@(FastString _ len _ fp _) = copyBytes (buf `plusPtr` i) ptr len writeFastMutInt r (i+len) -bPutLitString :: BufHandle -> Addr# -> Int# -> IO () -bPutLitString b@(BufHandle buf r hdl) a# len# = do - let len = I# len# +bPutLitString :: BufHandle -> LitString -> FastInt -> IO () +bPutLitString b@(BufHandle buf r hdl) a len_ = a `seq` do + let len = iBox len_ i <- readFastMutInt r if (i+len) >= buf_size then do hPutBuf hdl buf i writeFastMutInt r 0 if (len >= buf_size) - then hPutBuf hdl (Ptr a#) len - else bPutLitString b a# len# + then hPutBuf hdl a len + else bPutLitString b a len_ else do - copyBytes (buf `plusPtr` i) (Ptr a#) len + copyBytes (buf `plusPtr` i) a len writeFastMutInt r (i+len) bFlush :: BufHandle -> IO () -bFlush b@(BufHandle buf r hdl) = do +bFlush (BufHandle buf r hdl) = do i <- readFastMutInt r when (i > 0) $ hPutBuf hdl buf i free buf