Movatterモバイル変換

{-# 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.NumimportGHC.PtrimportGHC.WordimportGHC.ShowimportGHC.RealimportForeign.C.TypesimportForeign.ForeignPtrimportForeign.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 datatypeRawBuffere=ForeignPtrereadWord8Buf::RawBufferWord8->Int->IOWord8readWord8Buf :: RawBuffer Word8 -> Int -> IO Word8readWord8BufRawBuffer Word8arrIntix=RawBuffer Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithForeignPtrRawBuffer Word8arr((Ptr Word8 -> IO Word8) -> IO Word8)-> (Ptr Word8 -> IO Word8) -> IO Word8forall a b. (a -> b) -> a -> b$\Ptr Word8p->Ptr Word8 -> Int -> IO Word8forall a b. Storable a => Ptr b -> Int -> IO apeekByteOffPtr Word8pIntixwriteWord8Buf::RawBufferWord8->Int->Word8->IO()writeWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8BufRawBuffer Word8arrIntixWord8w=RawBuffer Word8 -> (Ptr Word8 -> IO ()) -> IO ()forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithForeignPtrRawBuffer Word8arr((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()forall a b. (a -> b) -> a -> b$\Ptr Word8p->Ptr Word8 -> Int -> Word8 -> IO ()forall a b. Storable a => Ptr b -> Int -> a -> IO ()pokeByteOffPtr Word8pIntixWord8w#if defined(CHARBUF_UTF16)typeCharBufElem=Word16#elsetypeCharBufElem=Char#endiftypeRawCharBuffer=RawBufferCharBufElempeekCharBuf::RawCharBuffer->Int->IOCharpeekCharBuf :: RawCharBuffer -> Int -> IO CharpeekCharBufRawCharBufferarrIntix=RawCharBuffer -> (Ptr Char -> IO Char) -> IO Charforall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithForeignPtrRawCharBufferarr((Ptr Char -> IO Char) -> IO Char)-> (Ptr Char -> IO Char) -> IO Charforall a b. (a -> b) -> a -> b$\Ptr Charp->do(Charc,Int_)<-Ptr Char -> Int -> IO (Char, Int)readCharBufPtrPtr CharpIntixChar -> IO Charforall (m :: * -> *) a. Monad m => a -> m areturnCharc{-# INLINEreadCharBuf#-}readCharBuf::RawCharBuffer->Int->IO(Char,Int)readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)readCharBufRawCharBufferarrIntix=RawCharBuffer -> (Ptr Char -> IO (Char, Int)) -> IO (Char, Int)forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithForeignPtrRawCharBufferarr((Ptr Char -> IO (Char, Int)) -> IO (Char, Int))-> (Ptr Char -> IO (Char, Int)) -> IO (Char, Int)forall a b. (a -> b) -> a -> b$\Ptr Charp->Ptr Char -> Int -> IO (Char, Int)readCharBufPtrPtr CharpIntix{-# INLINEwriteCharBuf#-}writeCharBuf::RawCharBuffer->Int->Char->IOIntwriteCharBuf :: RawCharBuffer -> Int -> Char -> IO IntwriteCharBufRawCharBufferarrIntixCharc=RawCharBuffer -> (Ptr Char -> IO Int) -> IO Intforall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithForeignPtrRawCharBufferarr((Ptr Char -> IO Int) -> IO Int) -> (Ptr Char -> IO Int) -> IO Intforall a b. (a -> b) -> a -> b$\Ptr Charp->Ptr Char -> Int -> Char -> IO IntwriteCharBufPtrPtr CharpIntixCharc{-# INLINEreadCharBufPtr#-}readCharBufPtr::PtrCharBufElem->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)#elsereadCharBufPtr :: Ptr Char -> Int -> IO (Char, Int)readCharBufPtrPtr CharpIntix=doCharc<-Ptr Char -> Int -> IO Charforall a. Storable a => Ptr a -> Int -> IO apeekElemOff(Ptr Char -> Ptr Charforall a b. Ptr a -> Ptr bcastPtrPtr Charp)Intix;(Char, Int) -> IO (Char, Int)forall (m :: * -> *) a. Monad m => a -> m areturn(Charc,IntixInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)#endif{-# INLINEwriteCharBufPtr#-}writeCharBufPtr::PtrCharBufElem->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#elsewriteCharBufPtr :: Ptr Char -> Int -> Char -> IO IntwriteCharBufPtrPtr CharpIntixCharch=doPtr Char -> Int -> Char -> IO ()forall a. Storable a => Ptr a -> Int -> a -> IO ()pokeElemOff(Ptr Char -> Ptr Charforall a b. Ptr a -> Ptr bcastPtrPtr Charp)IntixCharch;Int -> IO Intforall (m :: * -> *) a. Monad m => a -> m areturn(IntixInt -> Int -> Intforall a. Num a => a -> a -> a+Int1)#endifcharSize::Int#if defined(CHARBUF_UTF16)charSize=2#elsecharSize :: IntcharSize=Int4#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.dataBuffere=Buffer{Buffer e -> RawBuffer ebufRaw::!(RawBuffere),Buffer e -> BufferStatebufState::BufferState,Buffer e -> IntbufSize::!Int,-- in elements, not bytesBuffer e -> IntbufL::!Int,-- offset of first item in the bufferBuffer e -> IntbufR::!Int-- offset of last item + 1}#if defined(CHARBUF_UTF16)typeCharBuffer=BufferWord16#elsetypeCharBuffer=BufferChar#endifdataBufferState=ReadBuffer|WriteBufferderivingEq-- ^ @since 4.2.0.0withBuffer::Buffere->(Ptre->IOa)->IOawithBuffer :: Buffer e -> (Ptr e -> IO a) -> IO awithBufferBuffer{bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer eraw}Ptr e -> IO af=RawBuffer e -> (Ptr e -> IO a) -> IO aforall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithForeignPtr(RawBuffer e -> RawBuffer eforall a b. ForeignPtr a -> ForeignPtr bcastForeignPtrRawBuffer eraw)Ptr e -> IO afwithRawBuffer::RawBuffere->(Ptre->IOa)->IOawithRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO awithRawBufferRawBuffer erawPtr e -> IO af=RawBuffer e -> (Ptr e -> IO a) -> IO aforall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithForeignPtr(RawBuffer e -> RawBuffer eforall a b. ForeignPtr a -> ForeignPtr bcastForeignPtrRawBuffer eraw)Ptr e -> IO afisEmptyBuffer::Buffere->BoolisEmptyBuffer :: Buffer e -> BoolisEmptyBufferBuffer{bufL :: forall e. Buffer e -> IntbufL=Intl,bufR :: forall e. Buffer e -> IntbufR=Intr}=IntlInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==IntrisFullBuffer::Buffere->BoolisFullBuffer :: Buffer e -> BoolisFullBufferBuffer{bufR :: forall e. Buffer e -> IntbufR=Intw,bufSize :: forall e. Buffer e -> IntbufSize=Ints}=IntsInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==Intw-- if a Char buffer does not have room for a surrogate pair, it is "full"isFullCharBuffer::Buffere->Bool#if defined(CHARBUF_UTF16)isFullCharBufferbuf=bufferAvailablebuf<2#elseisFullCharBuffer :: Buffer e -> BoolisFullCharBuffer=Buffer e -> Boolforall e. Buffer e -> BoolisFullBuffer#endifisWriteBuffer::Buffere->BoolisWriteBuffer :: Buffer e -> BoolisWriteBufferBuffer ebuf=caseBuffer e -> BufferStateforall e. Buffer e -> BufferStatebufStateBuffer ebufofBufferStateWriteBuffer->BoolTrueBufferStateReadBuffer->BoolFalsebufferElems::Buffere->IntbufferElems :: Buffer e -> IntbufferElemsBuffer{bufR :: forall e. Buffer e -> IntbufR=Intw,bufL :: forall e. Buffer e -> IntbufL=Intr}=IntwInt -> Int -> Intforall a. Num a => a -> a -> a-IntrbufferAvailable::Buffere->IntbufferAvailable :: Buffer e -> IntbufferAvailableBuffer{bufR :: forall e. Buffer e -> IntbufR=Intw,bufSize :: forall e. Buffer e -> IntbufSize=Ints}=IntsInt -> Int -> Intforall a. Num a => a -> a -> a-IntwbufferRemove::Int->Buffere->BufferebufferRemove :: Int -> Buffer e -> Buffer ebufferRemoveIntibuf :: Buffer ebuf@Buffer{bufL :: forall e. Buffer e -> IntbufL=Intr}=Int -> Buffer e -> Buffer eforall e. Int -> Buffer e -> Buffer ebufferAdjustL(IntrInt -> Int -> Intforall a. Num a => a -> a -> a+Inti)Buffer ebufbufferAdjustL::Int->Buffere->BufferebufferAdjustL :: Int -> Buffer e -> Buffer ebufferAdjustLIntlbuf :: Buffer ebuf@Buffer{bufR :: forall e. Buffer e -> IntbufR=Intw}|IntlInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==Intw=Buffer ebuf{bufL :: IntbufL=Int0,bufR :: IntbufR=Int0}|Boolotherwise=Buffer ebuf{bufL :: IntbufL=Intl,bufR :: IntbufR=Intw}bufferAdd::Int->Buffere->BufferebufferAdd :: Int -> Buffer e -> Buffer ebufferAddIntibuf :: Buffer ebuf@Buffer{bufR :: forall e. Buffer e -> IntbufR=Intw}=Buffer ebuf{bufR :: IntbufR=IntwInt -> Int -> Intforall a. Num a => a -> a -> a+Inti}emptyBuffer::RawBuffere->Int->BufferState->BuffereemptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer eemptyBufferRawBuffer erawIntszBufferStatestate=Buffer :: forall e.RawBuffer e -> BufferState -> Int -> Int -> Int -> Buffer eBuffer{bufRaw :: RawBuffer ebufRaw=RawBuffer eraw,bufState :: BufferStatebufState=BufferStatestate,bufR :: IntbufR=Int0,bufL :: IntbufL=Int0,bufSize :: IntbufSize=Intsz}newByteBuffer::Int->BufferState->IO(BufferWord8)newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)newByteBufferIntcBufferStatest=Int -> Int -> BufferState -> IO (Buffer Word8)forall e. Int -> Int -> BufferState -> IO (Buffer e)newBufferIntcIntcBufferStatestnewCharBuffer::Int->BufferState->IOCharBuffernewCharBuffer :: Int -> BufferState -> IO CharBuffernewCharBufferIntcBufferStatest=Int -> Int -> BufferState -> IO CharBufferforall e. Int -> Int -> BufferState -> IO (Buffer e)newBuffer(IntcInt -> Int -> Intforall a. Num a => a -> a -> a*IntcharSize)IntcBufferStatestnewBuffer::Int->Int->BufferState->IO(Buffere)newBuffer :: Int -> Int -> BufferState -> IO (Buffer e)newBufferIntbytesIntszBufferStatestate=doForeignPtr efp<-Int -> IO (ForeignPtr e)forall a. Int -> IO (ForeignPtr a)mallocForeignPtrBytesIntbytesBuffer e -> IO (Buffer e)forall (m :: * -> *) a. Monad m => a -> m areturn(ForeignPtr e -> Int -> BufferState -> Buffer eforall e. RawBuffer e -> Int -> BufferState -> Buffer eemptyBufferForeignPtr efpIntszBufferStatestate)-- | slides the contents of the buffer to the beginningslideContents::BufferWord8->IO(BufferWord8)slideContents :: Buffer Word8 -> IO (Buffer Word8)slideContentsbuf :: Buffer Word8buf@Buffer{bufL :: forall e. Buffer e -> IntbufL=Intl,bufR :: forall e. Buffer e -> IntbufR=Intr,bufRaw :: forall e. Buffer e -> RawBuffer ebufRaw=RawBuffer Word8raw}=doletelems :: Intelems=IntrInt -> Int -> Intforall a. Num a => a -> a -> a-IntlRawBuffer Word8 -> (Ptr Word8 -> IO ()) -> IO ()forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO bwithRawBufferRawBuffer Word8raw((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()forall a b. (a -> b) -> a -> b$\Ptr Word8p->doPtr Word8_<-Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)memmovePtr Word8p(Ptr Word8pPtr Word8 -> Int -> Ptr Word8forall a b. Ptr a -> Int -> Ptr b`plusPtr`Intl)(Int -> CSizeforall a b. (Integral a, Num b) => a -> bfromIntegralIntelems)() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn()Buffer Word8 -> IO (Buffer Word8)forall (m :: * -> *) a. Monad m => a -> m areturnBuffer Word8buf{bufL :: IntbufL=Int0,bufR :: IntbufR=Intelems}foreignimportccallunsafe"memmove"memmove::Ptra->Ptra->CSize->IO(Ptra)summaryBuffer::Buffera->StringsummaryBuffer :: Buffer a -> StringsummaryBuffer!Buffer abuf-- Strict => slightly better code=String"buf"String -> String -> Stringforall a. [a] -> [a] -> [a]++Int -> Stringforall a. Show a => a -> Stringshow(Buffer a -> Intforall e. Buffer e -> IntbufSizeBuffer abuf)String -> String -> Stringforall a. [a] -> [a] -> [a]++String"("String -> String -> Stringforall a. [a] -> [a] -> [a]++Int -> Stringforall a. Show a => a -> Stringshow(Buffer a -> Intforall e. Buffer e -> IntbufLBuffer abuf)String -> String -> Stringforall a. [a] -> [a] -> [a]++String"-"String -> String -> Stringforall a. [a] -> [a] -> [a]++Int -> Stringforall a. Show a => a -> Stringshow(Buffer a -> Intforall e. Buffer e -> IntbufRBuffer abuf)String -> String -> Stringforall 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::Buffera->IO()checkBuffer :: Buffer a -> IO ()checkBufferbuf :: Buffer abuf@Buffer{bufState :: forall e. Buffer e -> BufferStatebufState=BufferStatestate,bufL :: forall e. Buffer e -> IntbufL=Intr,bufR :: forall e. Buffer e -> IntbufR=Intw,bufSize :: forall e. Buffer e -> IntbufSize=Intsize}=doBuffer a -> Bool -> IO ()forall a. Buffer a -> Bool -> IO ()checkBuffer abuf(IntsizeInt -> Int -> Boolforall a. Ord a => a -> a -> Bool>Int0Bool -> Bool -> Bool&&IntrInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<=IntwBool -> Bool -> Bool&&IntwInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<=IntsizeBool -> Bool -> Bool&&(IntrInt -> Int -> Boolforall a. Eq a => a -> a -> Bool/=IntwBool -> Bool -> Bool||BufferStatestateBufferState -> BufferState -> Boolforall a. Eq a => a -> a -> Bool==BufferStateWriteBufferBool -> Bool -> Bool||(IntrInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==Int0Bool -> Bool -> Bool&&IntwInt -> Int -> Boolforall a. Eq a => a -> a -> Bool==Int0))Bool -> Bool -> Bool&&(BufferStatestateBufferState -> BufferState -> Boolforall a. Eq a => a -> a -> Bool/=BufferStateWriteBufferBool -> Bool -> Bool||IntwInt -> Int -> Boolforall a. Ord a => a -> a -> Bool<Intsize)-- write buffer is never full)check::Buffera->Bool->IO()check :: Buffer a -> Bool -> IO ()checkBuffer a_BoolTrue=() -> IO ()forall (m :: * -> *) a. Monad m => a -> m areturn()checkBuffer abufBoolFalse=String -> IO ()forall a. String -> aerrorWithoutStackTrace(String"buffer invariant violation: "String -> String -> Stringforall a. [a] -> [a] -> [a]++Buffer a -> Stringforall a. Buffer a -> StringsummaryBufferBuffer abuf)