diff options
Diffstat (limited to 'compiler/utils/BufWrite.hs')
| -rw-r--r-- | compiler/utils/BufWrite.hs | 35 |
1 files changed, 32 insertions, 3 deletions
diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index eff57059de..99c043ce41 100644 --- a/compiler/utils/BufWrite.hs +++ b/compiler/utils/BufWrite.hs @@ -20,9 +20,12 @@ module BufWrite ( bPutFS, bPutFZS, bPutLitString, + bPutReplicate, bFlush, ) where +import GhcPrelude + import FastString import FastMutInt @@ -95,19 +98,45 @@ bPutCStringLen b@(BufHandle buf r hdl) cstr@(ptr, len) = do copyBytes (buf `plusPtr` i) ptr len writeFastMutInt r (i + len) -bPutLitString :: BufHandle -> LitString -> Int -> IO () -bPutLitString b@(BufHandle buf r hdl) a len = a `seq` do +bPutLitString :: BufHandle -> LitString -> IO () +bPutLitString b@(BufHandle buf r hdl) l@(LitString a len) = l `seq` do i <- readFastMutInt r if (i+len) >= buf_size then do hPutBuf hdl buf i writeFastMutInt r 0 if (len >= buf_size) then hPutBuf hdl a len - else bPutLitString b a len + else bPutLitString b l else do copyBytes (buf `plusPtr` i) a len writeFastMutInt r (i+len) +-- | Replicate an 8-bit character +bPutReplicate :: BufHandle -> Int -> Char -> IO () +bPutReplicate (BufHandle buf r hdl) len c = do + i <- readFastMutInt r + let oc = fromIntegral (ord c) + if (i+len) < buf_size + then do + fillBytes (buf `plusPtr` i) oc len + writeFastMutInt r (i+len) + else do + -- flush the current buffer + when (i /= 0) $ hPutBuf hdl buf i + if (len < buf_size) + then do + fillBytes buf oc len + writeFastMutInt r len + else do + -- fill a full buffer + fillBytes buf oc buf_size + -- flush it as many times as necessary + let go n | n >= buf_size = do + hPutBuf hdl buf buf_size + go (n-buf_size) + | otherwise = writeFastMutInt r n + go len + bFlush :: BufHandle -> IO () bFlush (BufHandle buf r hdl) = do i <- readFastMutInt r |