X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FBuffer.hs;h=70967772a4dc96f0f324bd4a34aea15a5eabcdbe;hb=7d39e10019df33f1a19d65b3c58c4d01a7dc8d30;hp=bcdaabda0dedf08605a3482d450db10051599b78;hpb=d2063b5b0be014545b21819172c87756efcb0b0c;p=ghc-base.git

diff --git a/GHC/IO/Buffer.hs b/GHC/IO/Buffer.hs
index bcdaabd..7096777 100644
--- a/GHC/IO/Buffer.hs
+++ b/GHC/IO/Buffer.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-implicit-prelude -funbox-strict-fields #-}
+{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -60,7 +60,7 @@ module GHC.IO.Buffer (
  ) where
 
 import GHC.Base
-import GHC.IO
+-- import GHC.IO
 import GHC.Num
 import GHC.Ptr
 import GHC.Word
@@ -77,9 +77,17 @@ import Foreign.Storable
 --   * a Char buffer consists of *valid* UTF-16 or UTF-32
 --   * only whole characters: no partial surrogate pairs
 
--- #define CHARBUF_UTF16
 #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 comparisions.
+
 -- ---------------------------------------------------------------------------
 -- Raw blocks of data
 
@@ -152,19 +160,21 @@ charSize = 4
 -- ---------------------------------------------------------------------------
 -- Buffers
 
--- The buffer is represented by a mutable variable containing a
--- record, where the record contains the raw buffer and the start/end
--- points of the filled portion.  We use a mutable variable so that
--- the common operation of writing (or reading) some data from (to)
--- the buffer doesn't need to modify, and hence copy, the handle
--- itself, it just updates the buffer.  
-
--- There will be some allocation involved in a simple hPutChar in
--- order to create the new Buffer structure (below), but this is
--- relatively small, and this only has to be done once per write
--- operation.
-
 -- | 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 exmaple, 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.
 data Buffer e
   = Buffer {
 	bufRaw   :: !(RawBuffer e),
@@ -189,7 +199,7 @@ withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a
 withRawBuffer raw f = withForeignPtr (castForeignPtr raw) f
 
 isEmptyBuffer :: Buffer e -> Bool
-isEmptyBuffer Buffer{ bufR=w } = w == 0
+isEmptyBuffer Buffer{ bufL=l, bufR=r } = l == r
 
 isFullBuffer :: Buffer e -> Bool
 isFullBuffer Buffer{ bufR=w, bufSize=s } = s == w
@@ -243,7 +253,9 @@ newBuffer bytes sz state = do
 slideContents :: Buffer Word8 -> IO (Buffer Word8)
 slideContents buf@Buffer{ bufL=l, bufR=r, bufRaw=raw } = do
   let elems = r - l
-  withRawBuffer raw $ \p -> memcpy p (p `plusPtr` l) (fromIntegral elems)
+  withRawBuffer raw $ \p ->
+      do _ <- memcpy p (p `plusPtr` l) (fromIntegral elems)
+         return ()
   return buf{ bufL=0, bufR=elems }
 
 foreign import ccall unsafe "memcpy"
@@ -254,8 +266,7 @@ summaryBuffer buf = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-"
 
 -- INVARIANTS on Buffers:
 --   * r <= w
---   * if r == w, then r == 0 && w == 0
---   * if state == WriteBuffer, then r == 0
+--   * 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.
@@ -268,8 +279,7 @@ checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do
       	size > 0
       	&& r <= w
       	&& w <= size
-      	&& ( r /= w || (r == 0 && w == 0) )
-        && ( state /= WriteBuffer || r == 0 )
+      	&& ( r /= w || state == WriteBuffer || (r == 0 && w == 0) )
         && ( state /= WriteBuffer || w < size ) -- write buffer is never full
       )