1 {-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}
2 -----------------------------------------------------------------------------
4 -- Module : GHC.IO.Buffer
5 -- Copyright : (c) The University of Glasgow 2008
6 -- License : see libraries/base/LICENSE
8 -- Maintainer : cvs-ghc@haskell.org
9 -- Stability : internal
10 -- Portability : non-portable (GHC Extensions)
12 -- Buffers used in the IO system
14 -----------------------------------------------------------------------------
16 module GHC.IO.Buffer (
17 -- * Buffers of any element
18 Buffer(..), BufferState(..), CharBuffer, CharBufElem,
26 -- ** Insertion/removal
41 -- ** Operating on the raw buffer as a Ptr
68 import Foreign.C.Types
69 import Foreign.ForeignPtr
70 import Foreign.Storable
72 -- Char buffers use either UTF-16 or UTF-32, with the endianness matching
73 -- the endianness of the host.
76 -- * a Char buffer consists of *valid* UTF-16 or UTF-32
77 -- * only whole characters: no partial surrogate pairs
81 -- #define CHARBUF_UTF16
83 -- NB. it won't work to just change this to CHARBUF_UTF16. Some of
84 -- the code to make this work is there, and it has been tested with
85 -- the Iconv codec, but there are some pieces that are known to be
86 -- broken. In particular, the built-in codecs
87 -- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or
88 -- similar in place of the ow >= os comparisions.
90 -- ---------------------------------------------------------------------------
93 type RawBuffer e = ForeignPtr e
95 readWord8Buf :: RawBuffer Word8 -> Int -> IO Word8
96 readWord8Buf arr ix = withForeignPtr arr $ \p -> peekByteOff p ix
98 writeWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()
99 writeWord8Buf arr ix w = withForeignPtr arr $ \p -> pokeByteOff p ix w
102 type CharBufElem = Word16
104 type CharBufElem = Char
107 type RawCharBuffer = RawBuffer CharBufElem
109 peekCharBuf :: RawCharBuffer -> Int -> IO Char
110 peekCharBuf arr ix = withForeignPtr arr $ \p -> do
111 (c,_) <- readCharBufPtr p ix
114 {-# INLINE readCharBuf #-}
115 readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)
116 readCharBuf arr ix = withForeignPtr arr $ \p -> readCharBufPtr p ix
118 {-# INLINE writeCharBuf #-}
119 writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int
120 writeCharBuf arr ix c = withForeignPtr arr $ \p -> writeCharBufPtr p ix c
122 {-# INLINE readCharBufPtr #-}
123 readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int)
125 readCharBufPtr p ix = do
126 c1 <- peekElemOff p ix
127 if (c1 < 0xd800 || c1 > 0xdbff)
128 then return (chr (fromIntegral c1), ix+1)
129 else do c2 <- peekElemOff p (ix+1)
130 return (unsafeChr ((fromIntegral c1 - 0xd800)*0x400 +
131 (fromIntegral c2 - 0xdc00) + 0x10000), ix+2)
133 readCharBufPtr p ix = do c <- peekElemOff (castPtr p) ix; return (c, ix+1)
136 {-# INLINE writeCharBufPtr #-}
137 writeCharBufPtr :: Ptr CharBufElem -> Int -> Char -> IO Int
139 writeCharBufPtr p ix ch
140 | c < 0x10000 = do pokeElemOff p ix (fromIntegral c)
142 | otherwise = do let c' = c - 0x10000
143 pokeElemOff p ix (fromIntegral (c' `div` 0x400 + 0xd800))
144 pokeElemOff p (ix+1) (fromIntegral (c' `mod` 0x400 + 0xdc00))
149 writeCharBufPtr p ix ch = do pokeElemOff (castPtr p) ix ch; return (ix+1)
159 -- ---------------------------------------------------------------------------
162 -- | A mutable array of bytes that can be passed to foreign functions.
164 -- The buffer is represented by a record, where the record contains
165 -- the raw buffer and the start/end points of the filled portion. The
166 -- buffer contents itself is mutable, but the rest of the record is
167 -- immutable. This is a slightly odd mix, but it turns out to be
168 -- quite practical: by making all the buffer metadata immutable, we
169 -- can have operations on buffer metadata outside of the IO monad.
171 -- The "live" elements of the buffer are those between the 'bufL' and
172 -- 'bufR' offsets. In an empty buffer, 'bufL' is equal to 'bufR', but
173 -- they might not be zero: for exmaple, the buffer might correspond to
174 -- a memory-mapped file and in which case 'bufL' will point to the
175 -- next location to be written, which is not necessarily the beginning
179 bufRaw :: !(RawBuffer e),
180 bufState :: BufferState,
181 bufSize :: !Int, -- in elements, not bytes
182 bufL :: !Int, -- offset of first item in the buffer
183 bufR :: !Int -- offset of last item + 1
187 type CharBuffer = Buffer Word16
189 type CharBuffer = Buffer Char
192 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
194 withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a
195 withBuffer Buffer{ bufRaw=raw } f = withForeignPtr (castForeignPtr raw) f
197 withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a
198 withRawBuffer raw f = withForeignPtr (castForeignPtr raw) f
200 isEmptyBuffer :: Buffer e -> Bool
201 isEmptyBuffer Buffer{ bufL=l, bufR=r } = l == r
203 isFullBuffer :: Buffer e -> Bool
204 isFullBuffer Buffer{ bufR=w, bufSize=s } = s == w
206 -- if a Char buffer does not have room for a surrogate pair, it is "full"
207 isFullCharBuffer :: Buffer e -> Bool
209 isFullCharBuffer buf = bufferAvailable buf < 2
211 isFullCharBuffer = isFullBuffer
214 isWriteBuffer :: Buffer e -> Bool
215 isWriteBuffer buf = case bufState buf of
219 bufferElems :: Buffer e -> Int
220 bufferElems Buffer{ bufR=w, bufL=r } = w - r
222 bufferAvailable :: Buffer e -> Int
223 bufferAvailable Buffer{ bufR=w, bufSize=s } = s - w
225 bufferRemove :: Int -> Buffer e -> Buffer e
226 bufferRemove i buf@Buffer{ bufL=r } = bufferAdjustL (r+i) buf
228 bufferAdjustL :: Int -> Buffer e -> Buffer e
229 bufferAdjustL l buf@Buffer{ bufR=w }
230 | l == w = buf{ bufL=0, bufR=0 }
231 | otherwise = buf{ bufL=l, bufR=w }
233 bufferAdd :: Int -> Buffer e -> Buffer e
234 bufferAdd i buf@Buffer{ bufR=w } = buf{ bufR=w+i }
236 emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e
237 emptyBuffer raw sz state =
238 Buffer{ bufRaw=raw, bufState=state, bufR=0, bufL=0, bufSize=sz }
240 newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)
241 newByteBuffer c st = newBuffer c c st
243 newCharBuffer :: Int -> BufferState -> IO CharBuffer
244 newCharBuffer c st = newBuffer (c * charSize) c st
246 newBuffer :: Int -> Int -> BufferState -> IO (Buffer e)
247 newBuffer bytes sz state = do
248 fp <- mallocForeignPtrBytes bytes
249 return (emptyBuffer fp sz state)
251 -- | slides the contents of the buffer to the beginning
252 slideContents :: Buffer Word8 -> IO (Buffer Word8)
253 slideContents buf@Buffer{ bufL=l, bufR=r, bufRaw=raw } = do
255 withRawBuffer raw $ \p ->
256 do _ <- memcpy p (p `plusPtr` l) (fromIntegral elems)
258 return buf{ bufL=0, bufR=elems }
260 foreign import ccall unsafe "memcpy"
261 memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())
263 summaryBuffer :: Buffer a -> String
264 summaryBuffer buf = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-" ++ show (bufR buf) ++ ")"
266 -- INVARIANTS on Buffers:
268 -- * if r == w, and the buffer is for reading, then r == 0 && w == 0
269 -- * a write buffer is never full. If an operation
270 -- fills up the buffer, it will always flush it before
272 -- * a read buffer may be full as a result of hLookAhead. In normal
273 -- operation, a read buffer always has at least one character of space.
275 checkBuffer :: Buffer a -> IO ()
276 checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do
281 && ( r /= w || state == WriteBuffer || (r == 0 && w == 0) )
282 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
285 check :: Buffer a -> Bool -> IO ()
286 check _ True = return ()
287 check buf False = error ("buffer invariant violation: " ++ summaryBuffer buf)