Tweak the BufferedIO class to enable a memory-mapped file implementation

[ghc-base.git] / GHC / IO / Handle / Internals.hs

diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index 739c422..403407f 100644 (file)
--- a/GHC/IO/Handle/Internals.hs
+++ b/GHC/IO/Handle/Internals.hs
@@ -31,7 +31,7 @@ module GHC.IO.Handle.Internals (
   wantSeekableHandle,
 
   mkHandle, mkFileHandle, mkDuplexHandle,
-  getEncoding, initBufferState,
+  openTextEncoding, initBufferState,
   dEFAULT_CHAR_BUFFER_SIZE,
 
   flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,
@@ -63,7 +63,6 @@ import qualified GHC.IO.BufferedIO as Buffered
 
 import GHC.Real
 import GHC.Base
-import GHC.List
 import GHC.Exception
 import GHC.Num          ( Num(..) )
 import GHC.Show
@@ -73,9 +72,8 @@ import Data.Typeable
 import Control.Monad
 import Data.Maybe
 import Foreign
-import System.IO.Error
+-- import System.IO.Error
 import System.Posix.Internals hiding (FD)
-import qualified System.Posix.Internals as Posix
 
 #ifdef DEBUG_DUMP
 import Foreign.C
@@ -207,7 +205,8 @@ checkWritableHandle act h_@Handle__{..}
            buf <- readIORef haCharBuffer
            writeIORef haCharBuffer buf{ bufState = WriteBuffer }
            buf <- readIORef haByteBuffer
-           writeIORef haByteBuffer buf{ bufState = WriteBuffer }
+           buf' <- Buffered.emptyWriteBuffer haDevice buf
+           writeIORef haByteBuffer buf'
         act h_
       _other               -> act h_
 
@@ -336,7 +335,7 @@ handleFinalizer fp m = do
       _ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()
                 -- ignore errors and async exceptions, and close the
                 -- descriptor anyway...
-              hClose_handle_ handle_
+              _ <- hClose_handle_ handle_
               return ()
   putMVar m (ioe_finalizedHandle fp)
 
@@ -432,7 +431,7 @@ flushCharReadBuffer Handle__{..} = do
   -- haLastDecode is the byte buffer just before we did our last batch of
   -- decoding.  We're going to re-decode the bytes up to the current char,
   -- to find out where we should revert the byte buffer to.
-  bbuf0 <- readIORef haLastDecode
+  (codec_state, bbuf0) <- readIORef haLastDecode
 
   cbuf0 <- readIORef haCharBuffer
   writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
@@ -453,24 +452,17 @@ flushCharReadBuffer Handle__{..} = do
     Just decoder -> do
       debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
                " cbuf=" ++ summaryBuffer cbuf0)
+
+      -- restore the codec state
+      setState decoder codec_state
     
       (bbuf1,cbuf1) <- (encode decoder) bbuf0
                                cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
     
-      -- tricky case: if the decoded string starts with e BOM, then it was
-      -- probably ignored last time we decoded these bytes, and we should
-      -- therefore decode another char.
-      (c,_) <- readCharBuf (bufRaw cbuf1) (bufL cbuf1)
-      (bbuf2,_) <- if (c == '\xfeff')
-                      then do debugIO "found BOM, decoding another char"
-                              (encode decoder) bbuf1
-                                      cbuf0{ bufL=0, bufR=0, bufSize = 1 }
-                      else return (bbuf1,cbuf1)
-    
       debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
                " cbuf=" ++ summaryBuffer cbuf1)
 
-      writeIORef haByteBuffer bbuf2
+      writeIORef haByteBuffer bbuf1
 
 
 -- When flushing the byte read buffer, we seek backwards by the number
@@ -508,12 +500,12 @@ mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
             -> IO Handle
 
 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
+   openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
+
    let buf_state = initBufferState ha_type
    bbuf <- Buffered.newBuffer dev buf_state
    bbufref <- newIORef bbuf
-   last_decode <- newIORef bbuf
-
-   (mb_encoder, mb_decoder) <- getEncoding mb_codec ha_type
+   last_decode <- newIORef (error "codec_state", bbuf)
 
    (cbufref,bmode) <- 
          if buffered then getCharBuffer dev buf_state
@@ -530,6 +522,7 @@ mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
                         haBuffers = spares,
                         haEncoder = mb_encoder,
                         haDecoder = mb_decoder,
+                        haCodec = mb_codec,
                         haInputNL = inputNL nl,
                         haOutputNL = outputNL nl,
                         haOtherSide = other_side
@@ -585,23 +578,25 @@ initBufferState :: HandleType -> BufferState
 initBufferState ReadHandle = ReadBuffer
 initBufferState _          = WriteBuffer
 
-getEncoding :: Maybe TextEncoding -> HandleType
-            -> IO (Maybe TextEncoder, 
-                   Maybe TextDecoder)
+openTextEncoding
+   :: Maybe TextEncoding
+   -> HandleType
+   -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
+   -> IO a
 
-getEncoding Nothing   ha_type = return (Nothing, Nothing)
-getEncoding (Just te) ha_type = do
+openTextEncoding Nothing   ha_type cont = cont Nothing Nothing
+openTextEncoding (Just TextEncoding{..}) ha_type cont = do
     mb_decoder <- if isReadableHandleType ha_type then do
-                     decoder <- mkTextDecoder te
+                     decoder <- mkTextDecoder
                      return (Just decoder)
                   else
                      return Nothing
     mb_encoder <- if isWritableHandleType ha_type then do
-                     encoder <- mkTextEncoder te
+                     encoder <- mkTextEncoder
                      return (Just encoder)
                   else 
                      return Nothing
-    return (mb_encoder, mb_decoder)
+    cont mb_encoder mb_decoder
 
 -- ---------------------------------------------------------------------------
 -- closing Handles
@@ -711,8 +706,8 @@ writeTextDevice h_@Handle__{..} cbuf = do
   debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++ 
         " bbuf=" ++ summaryBuffer bbuf')
 
-  Buffered.flushWriteBuffer haDevice bbuf'
-  writeIORef haByteBuffer bbuf{bufL=0,bufR=0}
+  bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'
+  writeIORef haByteBuffer bbuf'
   if not (isEmptyBuffer cbuf')
      then writeTextDevice h_ cbuf'
      else return ()
@@ -737,10 +732,15 @@ readTextDevice h_@Handle__{..} cbuf = do
 
   debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
 
-  writeIORef haLastDecode bbuf1
-  (bbuf2,cbuf') <- case haDecoder of
-                     Nothing      -> latin1_decode bbuf1 cbuf
-                     Just decoder -> (encode decoder) bbuf1 cbuf
+  (bbuf2,cbuf') <- 
+      case haDecoder of
+          Nothing      -> do
+               writeIORef haLastDecode (error "codec_state", bbuf1)
+               latin1_decode bbuf1 cbuf
+          Just decoder -> do
+               state <- getState decoder
+               writeIORef haLastDecode (state, bbuf1)
+               (encode decoder) bbuf1 cbuf
 
   debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ 
         " bbuf=" ++ summaryBuffer bbuf2)
@@ -766,10 +766,15 @@ readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
 
   debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)
 
-  writeIORef haLastDecode bbuf2
-  (bbuf3,cbuf') <- case haDecoder of
-                     Nothing      -> latin1_decode bbuf2 cbuf
-                     Just decoder -> (encode decoder) bbuf2 cbuf
+  (bbuf3,cbuf') <- 
+      case haDecoder of
+          Nothing      -> do
+               writeIORef haLastDecode (error "codec_state", bbuf2)
+               latin1_decode bbuf2 cbuf
+          Just decoder -> do
+               state <- getState decoder
+               writeIORef haLastDecode (state, bbuf2)
+               (encode decoder) bbuf2 cbuf
 
   debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ 
         " bbuf=" ++ summaryBuffer bbuf3)