X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO.hs;h=ca5a23ef0eae24bcb33a98fde51d966928671fc5;hb=a9fdb62ed158c777921127e2351bed89e9f06074;hp=27b59f1b571885c7104148e1b244b56a5266ac83;hpb=1771d527f12db6a2908d4d5c581aa91818a1b47f;p=haskell-directory.git diff --git a/GHC/IO.hs b/GHC/IO.hs index 27b59f1..ca5a23e 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-} +{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-} #undef DEBUG_DUMP @@ -16,6 +16,7 @@ -- ----------------------------------------------------------------------------- +-- #hide module GHC.IO ( hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, commitBuffer', -- hack, see below @@ -27,8 +28,6 @@ module GHC.IO ( memcpy_baoff_ptr, ) where -#include "config.h" - import Foreign import Foreign.C @@ -47,7 +46,7 @@ import GHC.Show import GHC.List import GHC.Exception ( ioError, catch ) -#ifdef mingw32_TARGET_OS +#ifdef mingw32_HOST_OS import GHC.Conc #endif @@ -93,7 +92,7 @@ hWaitForInput h msecs = do (fromIntegral msecs) (haIsStream handle_) return (r /= 0) -foreign import ccall unsafe "inputReady" +foreign import ccall safe "inputReady" inputReady :: CInt -> CInt -> Bool -> IO CInt -- --------------------------------------------------------------------------- @@ -402,15 +401,15 @@ unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s -- * 'isPermissionError' if another system resource limit would be exceeded. hPutChar :: Handle -> Char -> IO () -hPutChar handle c = - c `seq` do -- must evaluate c before grabbing the handle lock +hPutChar handle c = do + c `seq` return () wantWritableHandle "hPutChar" handle $ \ handle_ -> do let fd = haFD handle_ case haBufferMode handle_ of LineBuffering -> hPutcBuffered handle_ True c BlockBuffering _ -> hPutcBuffered handle_ False c NoBuffering -> - withObject (castCharToCChar c) $ \buf -> do + with (castCharToCChar c) $ \buf -> do writeRawBufferPtr "hPutChar" (fromIntegral fd) (haIsStream handle_) buf 0 1 return () @@ -727,7 +726,7 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return off loop off bytes = do -#ifndef mingw32_TARGET_OS +#ifndef mingw32_HOST_OS ssize <- c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) @@ -901,7 +900,7 @@ bufReadNonBlocking fd ref is_stream ptr so_far count = readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int readChunkNonBlocking fd is_stream ptr bytes = do -#ifndef mingw32_TARGET_OS +#ifndef mingw32_HOST_OS ssize <- c_read (fromIntegral fd) (castPtr ptr) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1)