{-# LANGUAGE Trustworthy, BangPatterns #-}{-# LANGUAGE CPP, NoImplicitPrelude #-}{-# OPTIONS_GHC -funbox-strict-fields #-}------------------------------------------------------------------------------- |-- Module : GHC.IO.Buffer-- Copyright : (c) The University of Glasgow 2008-- License : see libraries/base/LICENSE---- Maintainer : cvs-ghc@haskell.org-- Stability : internal-- Portability : non-portable (GHC Extensions)---- Buffers used in the IO system-------------------------------------------------------------------------------moduleGHC.IO.Buffer(-- * Buffers of any elementBuffer (..),BufferState (..),CharBuffer ,CharBufElem ,-- ** CreationnewByteBuffer ,newCharBuffer ,newBuffer ,emptyBuffer ,-- ** Insertion/removalbufferRemove ,bufferAdd ,slideContents ,bufferAdjustL ,-- ** InspectingisEmptyBuffer ,isFullBuffer ,isFullCharBuffer ,isWriteBuffer ,bufferElems ,bufferAvailable ,summaryBuffer ,-- ** Operating on the raw buffer as a PtrwithBuffer ,withRawBuffer ,-- ** AssertionscheckBuffer ,-- * Raw buffersRawBuffer ,readWord8Buf ,writeWord8Buf ,RawCharBuffer ,peekCharBuf ,readCharBuf ,writeCharBuf ,readCharBufPtr ,writeCharBufPtr ,charSize ,)whereimportGHC.Base -- import GHC.IOimportGHC.Num importGHC.Ptr importGHC.Word importGHC.Show importGHC.Real importForeign.C.Types importForeign.ForeignPtr importForeign.Storable -- Char buffers use either UTF-16 or UTF-32, with the endianness matching-- the endianness of the host.---- Invariants:-- * a Char buffer consists of *valid* UTF-16 or UTF-32-- * only whole characters: no partial surrogate pairs
#define CHARBUF_UTF32
-- #define CHARBUF_UTF16---- NB. it won't work to just change this to CHARBUF_UTF16. Some of-- the code to make this work is there, and it has been tested with-- the Iconv codec, but there are some pieces that are known to be-- broken. In particular, the built-in codecs-- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or-- similar in place of the ow >= os comparisons.-- ----------------------------------------------------------------------------- Raw blocks of datatypeRawBuffer e =ForeignPtr e readWord8Buf ::RawBuffer Word8 ->Int->IOWord8 readWord8Buf :: RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
arr Int
ix =RawBuffer Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RawBuffer Word8
arr ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
ix writeWord8Buf ::RawBuffer Word8 ->Int->Word8 ->IO()writeWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
arr Int
ix Word8
w =RawBuffer Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RawBuffer Word8
arr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p Int
ix Word8
w 
#if defined(CHARBUF_UTF16)
typeCharBufElem=Word16
#else
typeCharBufElem =Char
#endif
typeRawCharBuffer =RawBuffer CharBufElem peekCharBuf ::RawCharBuffer ->Int->IOCharpeekCharBuf :: RawCharBuffer -> Int -> IO Char
peekCharBuf RawCharBuffer
arr Int
ix =RawCharBuffer -> (Ptr Char -> IO Char) -> IO Char
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RawCharBuffer
arr ((Ptr Char -> IO Char) -> IO Char)
-> (Ptr Char -> IO Char) -> IO Char
forall a b. (a -> b) -> a -> b
$ \Ptr Char
p ->do(Char
c ,Int
_)<-Ptr Char -> Int -> IO (Char, Int)
readCharBufPtr Ptr Char
p Int
ix Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c {-# INLINEreadCharBuf #-}readCharBuf ::RawCharBuffer ->Int->IO(Char,Int)readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)
readCharBuf RawCharBuffer
arr Int
ix =RawCharBuffer -> (Ptr Char -> IO (Char, Int)) -> IO (Char, Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RawCharBuffer
arr ((Ptr Char -> IO (Char, Int)) -> IO (Char, Int))
-> (Ptr Char -> IO (Char, Int)) -> IO (Char, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Char
p ->Ptr Char -> Int -> IO (Char, Int)
readCharBufPtr Ptr Char
p Int
ix {-# INLINEwriteCharBuf #-}writeCharBuf ::RawCharBuffer ->Int->Char->IOIntwriteCharBuf :: RawCharBuffer -> Int -> Char -> IO Int
writeCharBuf RawCharBuffer
arr Int
ix Char
c =RawCharBuffer -> (Ptr Char -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RawCharBuffer
arr ((Ptr Char -> IO Int) -> IO Int) -> (Ptr Char -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Char
p ->Ptr Char -> Int -> Char -> IO Int
writeCharBufPtr Ptr Char
p Int
ix Char
c {-# INLINEreadCharBufPtr #-}readCharBufPtr ::Ptr CharBufElem ->Int->IO(Char,Int)
#if defined(CHARBUF_UTF16)
readCharBufPtrpix=doc1<-peekElemOffpixif(c1<0xd800||c1>0xdbff)thenreturn(chr(fromIntegralc1),ix+1)elsedoc2<-peekElemOffp(ix+1)return(unsafeChr((fromIntegralc1-0xd800)*0x400+(fromIntegralc2-0xdc00)+0x10000),ix+2)
#else
readCharBufPtr :: Ptr Char -> Int -> IO (Char, Int)
readCharBufPtr Ptr Char
p Int
ix =doChar
c <-Ptr Char -> Int -> IO Char
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr Char -> Ptr Char
forall a b. Ptr a -> Ptr b
castPtr Ptr Char
p )Int
ix ;(Char, Int) -> IO (Char, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c ,Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
#endif
{-# INLINEwriteCharBufPtr #-}writeCharBufPtr ::Ptr CharBufElem ->Int->Char->IOInt
#if defined(CHARBUF_UTF16)
writeCharBufPtrpixch|c<0x10000=dopokeElemOffpix(fromIntegralc)return(ix+1)|otherwise=doletc'=c-0x10000pokeElemOffpix(fromIntegral(c'`div`0x400+0xd800))pokeElemOffp(ix+1)(fromIntegral(c'`mod`0x400+0xdc00))return(ix+2)wherec=ordch
#else
writeCharBufPtr :: Ptr Char -> Int -> Char -> IO Int
writeCharBufPtr Ptr Char
p Int
ix Char
ch =doPtr Char -> Int -> Char -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr Char -> Ptr Char
forall a b. Ptr a -> Ptr b
castPtr Ptr Char
p )Int
ix Char
ch ;Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
#endif
charSize ::Int
#if defined(CHARBUF_UTF16)
charSize=2
#else
charSize :: Int
charSize =Int
4
#endif
-- ----------------------------------------------------------------------------- Buffers-- | A mutable array of bytes that can be passed to foreign functions.---- The buffer is represented by a record, where the record contains-- the raw buffer and the start/end points of the filled portion. The-- buffer contents itself is mutable, but the rest of the record is-- immutable. This is a slightly odd mix, but it turns out to be-- quite practical: by making all the buffer metadata immutable, we-- can have operations on buffer metadata outside of the IO monad.---- The "live" elements of the buffer are those between the 'bufL' and-- 'bufR' offsets. In an empty buffer, 'bufL' is equal to 'bufR', but-- they might not be zero: for example, the buffer might correspond to-- a memory-mapped file and in which case 'bufL' will point to the-- next location to be written, which is not necessarily the beginning-- of the file.dataBuffer e =Buffer {Buffer e -> RawBuffer e
bufRaw ::!(RawBuffer e ),Buffer e -> BufferState
bufState ::BufferState ,Buffer e -> Int
bufSize ::!Int,-- in elements, not bytesBuffer e -> Int
bufL ::!Int,-- offset of first item in the bufferBuffer e -> Int
bufR ::!Int-- offset of last item + 1}
#if defined(CHARBUF_UTF16)
typeCharBuffer=BufferWord16
#else
typeCharBuffer =Buffer Char
#endif
dataBufferState =ReadBuffer |WriteBuffer derivingEq-- ^ @since 4.2.0.0withBuffer ::Buffer e ->(Ptr e ->IOa )->IOa withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a
withBuffer Buffer {bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw =RawBuffer e
raw }Ptr e -> IO a
f =RawBuffer e -> (Ptr e -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (RawBuffer e -> RawBuffer e
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr RawBuffer e
raw )Ptr e -> IO a
f withRawBuffer ::RawBuffer e ->(Ptr e ->IOa )->IOa withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer e
raw Ptr e -> IO a
f =RawBuffer e -> (Ptr e -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (RawBuffer e -> RawBuffer e
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr RawBuffer e
raw )Ptr e -> IO a
f isEmptyBuffer ::Buffer e ->BoolisEmptyBuffer :: Buffer e -> Bool
isEmptyBuffer Buffer {bufL :: forall e. Buffer e -> Int
bufL =Int
l ,bufR :: forall e. Buffer e -> Int
bufR =Int
r }=Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
r isFullBuffer ::Buffer e ->BoolisFullBuffer :: Buffer e -> Bool
isFullBuffer Buffer {bufR :: forall e. Buffer e -> Int
bufR =Int
w ,bufSize :: forall e. Buffer e -> Int
bufSize =Int
s }=Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
w -- if a Char buffer does not have room for a surrogate pair, it is "full"isFullCharBuffer ::Buffer e ->Bool
#if defined(CHARBUF_UTF16)
isFullCharBufferbuf=bufferAvailablebuf<2
#else
isFullCharBuffer :: Buffer e -> Bool
isFullCharBuffer =Buffer e -> Bool
forall e. Buffer e -> Bool
isFullBuffer 
#endif
isWriteBuffer ::Buffer e ->BoolisWriteBuffer :: Buffer e -> Bool
isWriteBuffer Buffer e
buf =caseBuffer e -> BufferState
forall e. Buffer e -> BufferState
bufState Buffer e
buf ofBufferState
WriteBuffer ->Bool
TrueBufferState
ReadBuffer ->Bool
FalsebufferElems ::Buffer e ->IntbufferElems :: Buffer e -> Int
bufferElems Buffer {bufR :: forall e. Buffer e -> Int
bufR =Int
w ,bufL :: forall e. Buffer e -> Int
bufL =Int
r }=Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r bufferAvailable ::Buffer e ->IntbufferAvailable :: Buffer e -> Int
bufferAvailable Buffer {bufR :: forall e. Buffer e -> Int
bufR =Int
w ,bufSize :: forall e. Buffer e -> Int
bufSize =Int
s }=Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w bufferRemove ::Int->Buffer e ->Buffer e bufferRemove :: Int -> Buffer e -> Buffer e
bufferRemove Int
i buf :: Buffer e
buf @Buffer {bufL :: forall e. Buffer e -> Int
bufL =Int
r }=Int -> Buffer e -> Buffer e
forall e. Int -> Buffer e -> Buffer e
bufferAdjustL (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i )Buffer e
buf bufferAdjustL ::Int->Buffer e ->Buffer e bufferAdjustL :: Int -> Buffer e -> Buffer e
bufferAdjustL Int
l buf :: Buffer e
buf @Buffer {bufR :: forall e. Buffer e -> Int
bufR =Int
w }|Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
w =Buffer e
buf {bufL :: Int
bufL =Int
0,bufR :: Int
bufR =Int
0}|Bool
otherwise =Buffer e
buf {bufL :: Int
bufL =Int
l ,bufR :: Int
bufR =Int
w }bufferAdd ::Int->Buffer e ->Buffer e bufferAdd :: Int -> Buffer e -> Buffer e
bufferAdd Int
i buf :: Buffer e
buf @Buffer {bufR :: forall e. Buffer e -> Int
bufR =Int
w }=Buffer e
buf {bufR :: Int
bufR =Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i }emptyBuffer ::RawBuffer e ->Int->BufferState ->Buffer e emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e
emptyBuffer RawBuffer e
raw Int
sz BufferState
state =Buffer :: forall e.
RawBuffer e -> BufferState -> Int -> Int -> Int -> Buffer e
Buffer {bufRaw :: RawBuffer e
bufRaw =RawBuffer e
raw ,bufState :: BufferState
bufState =BufferState
state ,bufR :: Int
bufR =Int
0,bufL :: Int
bufL =Int
0,bufSize :: Int
bufSize =Int
sz }newByteBuffer ::Int->BufferState ->IO(Buffer Word8 )newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)
newByteBuffer Int
c BufferState
st =Int -> Int -> BufferState -> IO (Buffer Word8)
forall e. Int -> Int -> BufferState -> IO (Buffer e)
newBuffer Int
c Int
c BufferState
st newCharBuffer ::Int->BufferState ->IOCharBuffer newCharBuffer :: Int -> BufferState -> IO CharBuffer
newCharBuffer Int
c BufferState
st =Int -> Int -> BufferState -> IO CharBuffer
forall e. Int -> Int -> BufferState -> IO (Buffer e)
newBuffer (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
charSize )Int
c BufferState
st newBuffer ::Int->Int->BufferState ->IO(Buffer e )newBuffer :: Int -> Int -> BufferState -> IO (Buffer e)
newBuffer Int
bytes Int
sz BufferState
state =doForeignPtr e
fp <-Int -> IO (ForeignPtr e)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
bytes Buffer e -> IO (Buffer e)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr e -> Int -> BufferState -> Buffer e
forall e. RawBuffer e -> Int -> BufferState -> Buffer e
emptyBuffer ForeignPtr e
fp Int
sz BufferState
state )-- | slides the contents of the buffer to the beginningslideContents ::Buffer Word8 ->IO(Buffer Word8 )slideContents :: Buffer Word8 -> IO (Buffer Word8)
slideContents buf :: Buffer Word8
buf @Buffer {bufL :: forall e. Buffer e -> Int
bufL =Int
l ,bufR :: forall e. Buffer e -> Int
bufR =Int
r ,bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw =RawBuffer Word8
raw }=doletelems :: Int
elems =Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l RawBuffer Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withRawBuffer RawBuffer Word8
raw ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->doPtr Word8
_<-Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memmove Ptr Word8
p (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l )(Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
elems )() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()Buffer Word8 -> IO (Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
buf {bufL :: Int
bufL =Int
0,bufR :: Int
bufR =Int
elems }foreignimportccallunsafe"memmove"memmove ::Ptr a ->Ptr a ->CSize ->IO(Ptr a )summaryBuffer ::Buffer a ->String summaryBuffer :: Buffer a -> String
summaryBuffer !Buffer a
buf -- Strict => slightly better code=String
"buf"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Buffer a -> Int
forall e. Buffer e -> Int
bufSize Buffer a
buf )String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"("String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Buffer a -> Int
forall e. Buffer e -> Int
bufL Buffer a
buf )String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Buffer a -> Int
forall e. Buffer e -> Int
bufR Buffer a
buf )String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"-- INVARIANTS on Buffers:-- * r <= w-- * if r == w, and the buffer is for reading, then r == 0 && w == 0-- * a write buffer is never full. If an operation-- fills up the buffer, it will always flush it before-- returning.-- * a read buffer may be full as a result of hLookAhead. In normal-- operation, a read buffer always has at least one character of space.checkBuffer ::Buffer a ->IO()checkBuffer :: Buffer a -> IO ()
checkBuffer buf :: Buffer a
buf @Buffer {bufState :: forall e. Buffer e -> BufferState
bufState =BufferState
state ,bufL :: forall e. Buffer e -> Int
bufL =Int
r ,bufR :: forall e. Buffer e -> Int
bufR =Int
w ,bufSize :: forall e. Buffer e -> Int
bufSize =Int
size }=doBuffer a -> Bool -> IO ()
forall a. Buffer a -> Bool -> IO ()
check Buffer a
buf (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0Bool -> Bool -> Bool
&&Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
w Bool -> Bool -> Bool
&&Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
size Bool -> Bool -> Bool
&&(Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
w Bool -> Bool -> Bool
||BufferState
state BufferState -> BufferState -> Bool
forall a. Eq a => a -> a -> Bool
==BufferState
WriteBuffer Bool -> Bool -> Bool
||(Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0Bool -> Bool -> Bool
&&Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0))Bool -> Bool -> Bool
&&(BufferState
state BufferState -> BufferState -> Bool
forall a. Eq a => a -> a -> Bool
/=BufferState
WriteBuffer Bool -> Bool -> Bool
||Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
size )-- write buffer is never full)check ::Buffer a ->Bool->IO()check :: Buffer a -> Bool -> IO ()
check Buffer a
_Bool
True=() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()check Buffer a
buf Bool
False=String -> IO ()
forall a. String -> a
errorWithoutStackTrace (String
"buffer invariant violation: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Buffer a -> String
forall a. Buffer a -> String
summaryBuffer Buffer a
buf )