base 4.3.0.0 → 4.3.1.0
raw patch · 26 files changed
+634/−480 lines, 26 files
Files
- Control/Concurrent.hs +10/−0
- Control/Concurrent/SampleVar.hs +1/−1
- Control/Exception.hs +45/−2
- GHC/Conc.lhs +1/−0
- GHC/Conc/IO.hs +27/−1
- GHC/Float.lhs +22/−6
- GHC/IO/BufferedIO.hs +6/−9
- GHC/IO/Encoding/Iconv.hs +6/−6
- GHC/IO/FD.hs +23/−13
- GHC/IO/Handle.hs +17/−36
- GHC/IO/Handle/FD.hs +3/−4
- GHC/IO/Handle/Internals.hs +68/−57
- GHC/IO/Handle/Text.hs +84/−135
- GHC/IO/Handle/Types.hs +47/−17
- GHC/Num.lhs +1/−0
- GHC/Real.lhs +13/−0
- System/Event.hs +5/−1
- System/Event/Internal.hs +12/−2
- System/Event/KQueue.hsc +1/−1
- System/Event/Manager.hs +24/−13
- System/Event/Thread.hs +46/−7
- System/IO.hs +3/−12
- System/Mem/Weak.hs +4/−1
- base.cabal +1/−1
- configure +153/−144
- include/HsBaseConfig.h +11/−11
Control/Concurrent.hs view
@@ -450,6 +450,11 @@ -- | Block the current thread until data is available to read on the -- given file descriptor (GHC only).+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked. To safely close a file descriptor+-- that has been used with 'threadWaitRead', use+-- 'GHC.Conc.closeFdWith'. threadWaitRead :: Fd -> IO () threadWaitRead fd #ifdef mingw32_HOST_OS@@ -470,6 +475,11 @@ -- | Block the current thread until data can be written to the -- given file descriptor (GHC only).+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked. To safely close a file descriptor+-- that has been used with 'threadWaitWrite', use+-- 'GHC.Conc.closeFdWith'. threadWaitWrite :: Fd -> IO () threadWaitWrite fd #ifdef mingw32_HOST_OS
Control/Concurrent/SampleVar.hs view
@@ -120,5 +120,5 @@ isEmptySampleVar :: SampleVar a -> IO Bool isEmptySampleVar (SampleVar svar) = do (readers, _) <- readMVar svar- return (readers == 0)+ return (readers <= 0)
Control/Exception.hs view
@@ -243,7 +243,7 @@ > throwTo :: ThreadId -> Exception -> IO () -'throwTo' (also 'throwDynTo' and 'Control.Concurrent.killThread') allows one+'throwTo' (also 'Control.Concurrent.killThread') allows one running thread to raise an arbitrary exception in another thread. The exception is therefore asynchronous with respect to the target thread, which could be doing anything at the time it receives the exception.@@ -268,7 +268,7 @@ > (\e -> handler) If you need to unblock asynchronous exceptions again in the exception-handler, just use 'unblock' as normal.+handler, 'restore' can be used there too. Note that 'try' and friends /do not/ have a similar default, because there is no exception handler in this case. Don't use 'try' for@@ -301,6 +301,49 @@ until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds. Similar arguments apply for other interruptible operations like 'System.IO.openFile'.++It is useful to think of 'mask' not as a way to completely prevent+asynchronous exceptions, but as a filter that allows them to be raised+only at certain places. The main difficulty with asynchronous+exceptions is that they normally can occur anywhere, but within a+'mask' an asynchronous exception is only raised by operations that are+interruptible (or call other interruptible operations). In many cases+these operations may themselves raise exceptions, such as I\/O errors,+so the caller should be prepared to handle exceptions arising from the+operation anyway.++Sometimes it is too onerous to handle exceptions in the middle of a+critical piece of stateful code. There are three ways to handle this+kind of situation:++ * Use STM. Since a transaction is always either completely executed+ or not at all, transactions are a good way to maintain invariants+ over state in the presence of asynchronous (and indeed synchronous)+ exceptions.++ * Use 'mask', and avoid interruptible operations. In order to do+ this, we have to know which operations are interruptible. It is+ impossible to know for any given library function whether it might+ invoke an interruptible operation internally; so instead we give a+ list of guaranteed-not-to-be-interruptible operations below.++ * Use 'uninterruptibleMask'. This is generally not recommended,+ unless you can guarantee that any interruptible operations invoked+ during the scope of 'uninterruptibleMask' can only ever block for+ a short time. Otherwise, 'uninterruptibleMask' is a good way to+ make your program deadlock and be unresponsive to user interrupts.++The following operations are guaranteed not to be interruptible:++ * operations on 'IORef' from "Data.IORef"+ * STM transactions that do not use 'retry'+ * everything from the @Foreign@ modules+ * everything from @Control.Exception@+ * @tryTakeMVar@, @tryPutMVar@, @isEmptyMVar@+ * @takeMVar@ if the @MVar@ is definitely full, and conversely @putMVar@ if the @MVar@ is definitely empty+ * @newEmptyMVar@, @newMVar@+ * @forkIO@, @forkIOUnmasked@, @myThreadId@+ -} {- $catchall
GHC/Conc.lhs view
@@ -52,6 +52,7 @@ , registerDelay -- :: Int -> IO (TVar Bool) , threadWaitRead -- :: Int -> IO () , threadWaitWrite -- :: Int -> IO ()+ , closeFdWith -- :: (Fd -> IO ()) -> Fd -> IO () -- * TVars , STM(..)
GHC/Conc/IO.hs view
@@ -31,6 +31,7 @@ , registerDelay -- :: Int -> IO (TVar Bool) , threadWaitRead -- :: Int -> IO () , threadWaitWrite -- :: Int -> IO ()+ , closeFdWith -- :: (Fd -> IO ()) -> Fd -> IO () #ifdef mingw32_HOST_OS , asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)@@ -70,6 +71,10 @@ -- | Block the current thread until data is available to read on the -- given file descriptor (GHC only).+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked. To safely close a file descriptor+-- that has been used with 'threadWaitRead', use 'closeFdWith'. threadWaitRead :: Fd -> IO () threadWaitRead fd #ifndef mingw32_HOST_OS@@ -82,6 +87,10 @@ -- | Block the current thread until data can be written to the -- given file descriptor (GHC only).+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked. To safely close a file descriptor+-- that has been used with 'threadWaitWrite', use 'closeFdWith'. threadWaitWrite :: Fd -> IO () threadWaitWrite fd #ifndef mingw32_HOST_OS@@ -92,6 +101,23 @@ case waitWrite# fd# s of { s' -> (# s', () #) }} +-- | Close a file descriptor in a concurrency-safe way (GHC only). If+-- you are using 'threadWaitRead' or 'threadWaitWrite' to perform+-- blocking I\/O, you /must/ use this function to close file+-- descriptors, or blocked threads may not be woken.+--+-- Any threads that are blocked on the file descriptor via+-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having+-- IO exceptions thrown.+closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.+ -> Fd -- ^ File descriptor to close.+ -> IO ()+closeFdWith close fd+#ifndef mingw32_HOST_OS+ | threaded = Event.closeFdWith close fd+#endif+ | otherwise = close fd+ -- | Suspends the current thread for a given number of microseconds -- (GHC only). --@@ -107,7 +133,7 @@ | threaded = Event.threadDelay time #endif | otherwise = IO $ \s ->- case fromIntegral time of { I# time# ->+ case time of { I# time# -> case delay# time# s of { s' -> (# s', () #) }}
GHC/Float.lhs view
@@ -600,7 +600,7 @@ if e >= 0 then let be = b^ e in if f == b^(p-1) then- (f*be*b*2, 2*b, be*b, b)+ (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig else (f*be*2, 2, be, be) else@@ -614,11 +614,27 @@ k0 :: Int k0 = if b == 2 && base == 10 then- -- logBase 10 2 is slightly bigger than 3/10 so- -- the following will err on the low side. Ignoring- -- the fraction will make it err even more.- -- Haskell promises that p-1 <= logBase b f < p.- (p - 1 + e0) * 3 `div` 10+ -- logBase 10 2 is very slightly larger than 8651/28738+ -- (about 5.3558e-10), so if log x >= 0, the approximation+ -- k1 is too small, hence we add one and need one fixup step less.+ -- If log x < 0, the approximation errs rather on the high side.+ -- That is usually more than compensated for by ignoring the+ -- fractional part of logBase 2 x, but when x is a power of 1/2+ -- or slightly larger and the exponent is a multiple of the+ -- denominator of the rational approximation to logBase 10 2,+ -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,+ -- we get a leading zero-digit we don't want.+ -- With the approximation 3/10, this happened for+ -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.+ -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x+ -- for IEEE-ish floating point types with exponent fields+ -- <= 17 bits and mantissae of several thousand bits, earlier+ -- convergents to logBase 10 2 would fail for long double.+ -- Using quot instead of div is a little faster and requires+ -- fewer fixup steps for negative lx.+ let lx = p - 1 + e0+ k1 = (lx * 8651) `quot` 28738+ in if lx >= 0 then k1 + 1 else k1 else -- f :: Integer, log :: Float -> Float, -- ceiling :: Float -> Int
GHC/IO/BufferedIO.hs view
@@ -22,7 +22,6 @@ import GHC.Ptr import Data.Word import GHC.Num-import GHC.Real import Data.Maybe -- import GHC.IO import GHC.IO.Device as IODevice@@ -93,9 +92,8 @@ readBuf dev bbuf = do let bytes = bufferAvailable bbuf res <- withBuffer bbuf $ \ptr ->- RawIO.read dev (ptr `plusPtr` bufR bbuf) (fromIntegral bytes)- let res' = fromIntegral res- return (res', bbuf{ bufR = bufR bbuf + res' })+ RawIO.read dev (ptr `plusPtr` bufR bbuf) bytes+ return (res, bbuf{ bufR = bufR bbuf + res }) -- zero indicates end of file readBufNonBlocking :: RawIO dev => dev -> Buffer Word8@@ -105,16 +103,16 @@ readBufNonBlocking dev bbuf = do let bytes = bufferAvailable bbuf res <- withBuffer bbuf $ \ptr ->- IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) (fromIntegral bytes)+ IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) bytes case res of Nothing -> return (Nothing, bbuf)- Just n -> return (Just n, bbuf{ bufR = bufR bbuf + fromIntegral n })+ Just n -> return (Just n, bbuf{ bufR = bufR bbuf + n }) writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8) writeBuf dev bbuf = do let bytes = bufferElems bbuf withBuffer bbuf $ \ptr ->- IODevice.write dev (ptr `plusPtr` bufL bbuf) (fromIntegral bytes)+ IODevice.write dev (ptr `plusPtr` bufL bbuf) bytes return bbuf{ bufL=0, bufR=0 } -- XXX ToDo@@ -122,6 +120,5 @@ writeBufNonBlocking dev bbuf = do let bytes = bufferElems bbuf res <- withBuffer bbuf $ \ptr ->- IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf)- (fromIntegral bytes)+ IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf) bytes return (res, bufferAdjustL res bbuf)
GHC/IO/Encoding/Iconv.hs view
@@ -194,11 +194,10 @@ else do errno <- getErrno case errno of- e | e == eINVAL - || (e == e2BIG || e == eILSEQ) && new_inleft' /= (iw-ir) -> do+ e | e == eINVAL || e == e2BIG+ || e == eILSEQ && new_inleft' /= (iw-ir) -> do iconv_trace ("iconv ignoring error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))- -- Output overflow is relatively harmless, unless- -- we made no progress at all. + -- Output overflow is harmless -- -- Similarly, we ignore EILSEQ unless we converted no -- characters. Sometimes iconv reports EILSEQ for a@@ -211,8 +210,9 @@ -- the buffer have been drained. return (new_input, new_output) - _other -> - throwErrno "iconvRecoder" + e -> do+ iconv_trace ("iconv returned error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))+ throwErrno "iconvRecoder" -- illegal sequence, or some other error #endif /* !mingw32_HOST_OS */
GHC/IO/FD.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-}+-- Whether there are identities depends on the platform {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -98,8 +99,15 @@ dup = dup dup2 = dup2 +-- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is+-- taken from the value of BUFSIZ on the current platform. This value+-- varies too much though: it is 512 on Windows, 1024 on OS X and 8192+-- on Linux. So let's just use a decent size on every platform:+dEFAULT_FD_BUFFER_SIZE :: Int+dEFAULT_FD_BUFFER_SIZE = 8096+ instance BufferedIO FD where- newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state+ newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state fillReadBuffer fd buf = readBuf' fd buf fillReadBuffer0 fd buf = readBufNonBlocking fd buf flushWriteBuffer fd buf = writeBuf' fd buf@@ -156,7 +164,7 @@ -- always returns EISDIR if the file is a directory and was opened -- for writing, so I think we're ok with a single open() here... fd <- throwErrnoIfMinus1Retry "openFile"- (c_open f (fromIntegral oflags) 0o666)+ (c_open f oflags 0o666) (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-} False{-not a socket-} @@ -278,15 +286,17 @@ close :: FD -> IO () close fd = #ifndef mingw32_HOST_OS- (flip finally) (release fd) $ do+ (flip finally) (release fd) $ #endif- throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $+ do let closer realFd =+ throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $ #ifdef mingw32_HOST_OS- if fdIsSocket fd then- c_closesocket (fdFD fd)- else+ if fdIsSocket fd then+ c_closesocket (fromIntegral realFd)+ else #endif- c_close (fdFD fd)+ c_close (fromIntegral realFd)+ closeFdWith closer (fromIntegral (fdFD fd)) release :: FD -> IO () #ifdef mingw32_HOST_OS@@ -394,17 +404,17 @@ -- Reading and Writing fdRead :: FD -> Ptr Word8 -> Int -> IO Int-fdRead fd ptr bytes = do- r <- readRawBufferPtr "GHC.IO.FD.fdRead" fd ptr 0 (fromIntegral bytes)- return (fromIntegral r)+fdRead fd ptr bytes+ = do { r <- readRawBufferPtr "GHC.IO.FD.fdRead" fd ptr 0 (fromIntegral bytes)+ ; return (fromIntegral r) } fdReadNonBlocking :: FD -> Ptr Word8 -> Int -> IO (Maybe Int) fdReadNonBlocking fd ptr bytes = do r <- readRawBufferPtrNoBlock "GHC.IO.FD.fdReadNonBlocking" fd ptr 0 (fromIntegral bytes)- case r of+ case fromIntegral r of (-1) -> return (Nothing)- n -> return (Just (fromIntegral n))+ n -> return (Just n) fdWrite :: FD -> Ptr Word8 -> Int -> IO ()
GHC/IO/Handle.hs view
@@ -1,5 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -XRecordWildCards #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-}+{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}+ ----------------------------------------------------------------------------- -- | -- Module : GHC.IO.Handle@@ -81,14 +82,11 @@ mb_exc <- hClose' h m hClose_maybethrow mb_exc h hClose h@(DuplexHandle _ r w) = do- mb_exc1 <- hClose' h w- mb_exc2 <- hClose' h r- case mb_exc1 of- Nothing -> return ()- Just e -> hClose_maybethrow mb_exc2 h+ excs <- mapM (hClose' h) [r,w]+ hClose_maybethrow (listToMaybe (catMaybes excs)) h hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()-hClose_maybethrow Nothing h = return ()+hClose_maybethrow Nothing h = return () hClose_maybethrow (Just e) h = hClose_rethrow e h hClose_rethrow :: SomeException -> Handle -> IO ()@@ -205,32 +203,12 @@ _ -> do if mode == haBufferMode then return handle_ else do - {- Note:- - we flush the old buffer regardless of whether- the new buffer could fit the contents of the old buffer - or not.- - allow a handle's buffering to change even if IO has- occurred (ANSI C spec. does not allow this, nor did- the previous implementation of IO.hSetBuffering).- - a non-standard extension is to allow the buffering- of semi-closed handles to change [sof 6/98]- -}- flushCharBuffer handle_-- let state = initBufferState haType- reading = not (isWritableHandleType haType)+ -- See [note Buffer Sizing] in GHC.IO.Handle.Types - new_buf <-- case mode of- -- See [note Buffer Sizing], GHC.IO.Handle.Types- NoBuffering | reading -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state- | otherwise -> newCharBuffer 1 state- LineBuffering -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state- BlockBuffering Nothing -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state+ -- check for errors:+ case mode of BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n- | otherwise -> newCharBuffer n state-- writeIORef haCharBuffer new_buf+ _ -> return () -- for input terminals we need to put the terminal into -- cooked or raw mode depending on the type of buffering.@@ -436,14 +414,17 @@ posn <- IODevice.tell haDevice - cbuf <- readIORef haCharBuffer+ -- we can't tell the real byte offset if there are buffered+ -- Chars, so must flush first:+ flushCharBuffer handle_+ bbuf <- readIORef haByteBuffer - let real_posn - | isWriteBuffer cbuf = posn + fromIntegral (bufR cbuf)- | otherwise = posn - fromIntegral (bufR cbuf - bufL cbuf)- - fromIntegral (bufR bbuf - bufL bbuf)+ let real_posn+ | isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)+ | otherwise = posn - fromIntegral (bufferElems bbuf) + cbuf <- readIORef haCharBuffer debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn)) debugIO (" cbuf: " ++ summaryBuffer cbuf ++ " bbuf: " ++ summaryBuffer bbuf)
GHC/IO/Handle/FD.hs view
@@ -21,7 +21,6 @@ ) where import GHC.Base-import GHC.Real import GHC.Show import Data.Maybe -- import Control.Monad@@ -240,7 +239,7 @@ Just RegularFile -> Nothing -- no stat required for streams etc.: Just other -> Just (other,0,0)- (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode mb_stat+ (fd,fd_type) <- FD.mkFD fdint iomode mb_stat is_socket is_socket mkHandleFromFD fd fd_type filepath iomode is_socket@@ -255,8 +254,8 @@ -- translation instead. fdToHandle :: Posix.FD -> IO Handle fdToHandle fdint = do- iomode <- Posix.fdGetMode (fromIntegral fdint)- (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode Nothing+ iomode <- Posix.fdGetMode fdint+ (fd,fd_type) <- FD.mkFD fdint iomode Nothing False{-is_socket-} -- NB. the is_socket flag is False, meaning that: -- on Windows we're guessing this is not a socket (XXX)
GHC/IO/Handle/Internals.hs view
@@ -1,8 +1,7 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# OPTIONS_GHC -XRecordWildCards #-} {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NoImplicitPrelude, RecordWildCards, BangPatterns #-} ----------------------------------------------------------------------------- -- |@@ -31,10 +30,10 @@ openTextEncoding, closeTextCodecs, initBufferState, dEFAULT_CHAR_BUFFER_SIZE, - flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,- flushCharBuffer, flushByteReadBuffer,+ flushBuffer, flushWriteBuffer, flushCharReadBuffer,+ flushCharBuffer, flushByteReadBuffer, flushByteWriteBuffer, - readTextDevice, writeTextDevice, readTextDeviceNonBlocking,+ readTextDevice, writeCharBuffer, readTextDeviceNonBlocking, decodeByteBuf, augmentIOError,@@ -221,7 +220,9 @@ wantWritableHandle fun h@(FileHandle _ m) act = wantWritableHandle' fun h m act wantWritableHandle fun h@(DuplexHandle _ _ m) act- = withHandle_' fun h m act+ = wantWritableHandle' fun h m act+ -- we know it's not a ReadHandle or ReadWriteHandle, but we have to+ -- check for ClosedHandle/SemiClosedHandle. (#4808) wantWritableHandle' :: String -> Handle -> MVar Handle__@@ -258,7 +259,9 @@ wantReadableHandle_ fun h@(FileHandle _ m) act = wantReadableHandle' fun h m act wantReadableHandle_ fun h@(DuplexHandle _ m _) act- = withHandle_' fun h m act+ = wantReadableHandle' fun h m act+ -- we know it's not a WriteHandle or ReadWriteHandle, but we have to+ -- check for ClosedHandle/SemiClosedHandle. (#4808) wantReadableHandle' :: String -> Handle -> MVar Handle__@@ -276,9 +279,10 @@ ReadWriteHandle -> do -- a read/write handle and we want to read from it. We must -- flush all buffered write data first.- cbuf <- readIORef haCharBuffer- when (isWriteBuffer cbuf) $ do- cbuf' <- flushWriteBuffer_ h_ cbuf+ bbuf <- readIORef haByteBuffer+ when (isWriteBuffer bbuf) $ do+ when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_+ cbuf' <- readIORef haCharBuffer writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer } bbuf <- readIORef haByteBuffer writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }@@ -386,7 +390,7 @@ -- using an 8k char buffer instead of 32k improved performance for a -- basic "cat" program by ~30% for me. --SDM dEFAULT_CHAR_BUFFER_SIZE :: Int-dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4+dEFAULT_CHAR_BUFFER_SIZE = 2048 -- 8k/sizeof(HsChar) getCharBuffer :: IODevice dev => dev -> BufferState -> IO (IORef CharBuffer, BufferMode)@@ -403,9 +407,8 @@ mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode) mkUnBuffer state = do- buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types- ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state- WriteBuffer -> newCharBuffer 1 state+ buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state+ -- See [note Buffer Sizing], GHC.IO.Handle.Types ref <- newIORef buffer return (ref, NoBuffering) @@ -423,20 +426,18 @@ flushCharReadBuffer h_ flushByteReadBuffer h_ WriteBuffer -> do- buf' <- flushWriteBuffer_ h_ buf- writeIORef haCharBuffer buf'+ flushByteWriteBuffer h_ --- | flushes at least the Char buffer, and the byte buffer for a write--- Handle. Works on all Handles.+-- | flushes the Char buffer only. Works on all Handles. flushCharBuffer :: Handle__ -> IO () flushCharBuffer h_@Handle__{..} = do- buf <- readIORef haCharBuffer- case bufState buf of+ cbuf <- readIORef haCharBuffer+ case bufState cbuf of ReadBuffer -> do flushCharReadBuffer h_- WriteBuffer -> do- buf' <- flushWriteBuffer_ h_ buf- writeIORef haCharBuffer buf'+ WriteBuffer ->+ when (not (isEmptyBuffer cbuf)) $+ error "internal IO library error: Char buffer non-empty" -- ----------------------------------------------------------------------------- -- Writing data (flushing write buffers)@@ -446,20 +447,53 @@ -- empty. flushWriteBuffer :: Handle__ -> IO () flushWriteBuffer h_@Handle__{..} = do- buf <- readIORef haCharBuffer- if isWriteBuffer buf- then do buf' <- flushWriteBuffer_ h_ buf- writeIORef haCharBuffer buf'- else return ()+ buf <- readIORef haByteBuffer+ when (isWriteBuffer buf) $ flushByteWriteBuffer h_ -flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer-flushWriteBuffer_ h_@Handle__{..} cbuf = do+flushByteWriteBuffer :: Handle__ -> IO ()+flushByteWriteBuffer h_@Handle__{..} = do bbuf <- readIORef haByteBuffer- if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf)- then do writeTextDevice h_ cbuf- return cbuf{ bufL=0, bufR=0 }- else return cbuf+ when (not (isEmptyBuffer bbuf)) $ do+ bbuf' <- Buffered.flushWriteBuffer haDevice bbuf+ writeIORef haByteBuffer bbuf' +-- write the contents of the CharBuffer to the Handle__.+-- The data will be encoded and pushed to the byte buffer,+-- flushing if the buffer becomes full.+writeCharBuffer :: Handle__ -> CharBuffer -> IO ()+writeCharBuffer h_@Handle__{..} !cbuf = do+ --+ bbuf <- readIORef haByteBuffer++ debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf +++ " bbuf=" ++ summaryBuffer bbuf)++ (cbuf',bbuf') <- case haEncoder of+ Nothing -> latin1_encode cbuf bbuf+ Just encoder -> (encode encoder) cbuf bbuf++ debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' +++ " bbuf=" ++ summaryBuffer bbuf')++ -- flush if the write buffer is full+ if isFullBuffer bbuf'+ -- or we made no progress+ || not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf+ -- or the byte buffer has more elements than the user wanted buffered+ || (case haBufferMode of+ BlockBuffering (Just s) -> bufferElems bbuf' >= s+ NoBuffering -> True+ _other -> False)+ then do+ bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'+ writeIORef haByteBuffer bbuf''+ else+ writeIORef haByteBuffer bbuf'++ if not (isEmptyBuffer cbuf')+ then writeCharBuffer h_ cbuf'+ else return ()+ -- ----------------------------------------------------------------------------- -- Flushing read buffers @@ -732,29 +766,6 @@ -- ---------------------------------------------------------------------------- -- Text input/output---- Write the contents of the supplied Char buffer to the device, return--- only when all the data has been written.-writeTextDevice :: Handle__ -> CharBuffer -> IO ()-writeTextDevice h_@Handle__{..} cbuf = do- --- bbuf <- readIORef haByteBuffer-- debugIO ("writeTextDevice: cbuf=" ++ summaryBuffer cbuf ++ - " bbuf=" ++ summaryBuffer bbuf)-- (cbuf',bbuf') <- case haEncoder of- Nothing -> latin1_encode cbuf bbuf- Just encoder -> (encode encoder) cbuf bbuf-- debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++ - " bbuf=" ++ summaryBuffer bbuf')-- bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'- writeIORef haByteBuffer bbuf'- if not (isEmptyBuffer cbuf')- then writeTextDevice h_ cbuf'- else return () -- Read characters into the provided buffer. Return when any -- characters are available; raise an exception if the end of
GHC/IO/Handle/Text.hs view
@@ -1,8 +1,7 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}-{-# OPTIONS_GHC -XRecordWildCards -XBangPatterns #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NoImplicitPrelude, RecordWildCards, BangPatterns #-} ----------------------------------------------------------------------------- -- |@@ -23,7 +22,7 @@ hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, commitBuffer', -- hack, see below hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,- memcpy,+ memcpy, hPutStrLn, ) where import GHC.IO@@ -440,12 +439,10 @@ hPutChar handle c = do c `seq` return () wantWritableHandle "hPutChar" handle $ \ handle_ -> do- case haBufferMode handle_ of- LineBuffering -> hPutcBuffered handle_ True c- _other -> hPutcBuffered handle_ False c+ hPutcBuffered handle_ c -hPutcBuffered :: Handle__ -> Bool -> Char -> IO ()-hPutcBuffered handle_@Handle__{..} is_line c = do+hPutcBuffered :: Handle__ -> Char -> IO ()+hPutcBuffered handle_@Handle__{..} c = do buf <- readIORef haCharBuffer if c == '\n' then do buf1 <- if haOutputNL == CRLF@@ -454,23 +451,21 @@ putc buf1 '\n' else do putc buf '\n'- if is_line - then do- flushed_buf <- flushWriteBuffer_ handle_ buf1- writeIORef haCharBuffer flushed_buf- else- writeIORef haCharBuffer buf1+ writeCharBuffer handle_ buf1+ when is_line $ flushByteWriteBuffer handle_ else do buf1 <- putc buf c- writeIORef haCharBuffer buf1+ writeCharBuffer handle_ buf1+ return () where+ is_line = case haBufferMode of+ LineBuffering -> True+ _ -> False+ putc buf@Buffer{ bufRaw=raw, bufR=w } c = do debugIO ("putc: " ++ summaryBuffer buf) w' <- writeCharBuf raw w c- let buf' = buf{ bufR = w' }- if isFullCharBuffer buf'- then flushWriteBuffer_ handle_ buf'- else return buf'+ return buf{ bufR = w' } -- --------------------------------------------------------------------------- -- hPutStr@@ -502,8 +497,19 @@ -- * 'isPermissionError' if another system resource limit would be exceeded. hPutStr :: Handle -> String -> IO ()-hPutStr handle str = do- (buffer_mode, nl) <- +hPutStr handle str = hPutStr' handle str False++-- | The same as 'hPutStr', but adds a newline character.+hPutStrLn :: Handle -> String -> IO ()+hPutStrLn handle str = hPutStr' handle str True+ -- An optimisation: we treat hPutStrLn specially, to avoid the+ -- overhead of a single putChar '\n', which is quite high now that we+ -- have to encode eagerly.++hPutStr' :: Handle -> String -> Bool -> IO ()+hPutStr' handle str add_nl =+ do+ (buffer_mode, nl) <- wantWritableHandle "hPutStr" handle $ \h_ -> do bmode <- getSpareBuffer h_ return (bmode, haOutputNL h_)@@ -511,10 +517,11 @@ case buffer_mode of (NoBuffering, _) -> do hPutChars handle str -- v. slow, but we don't care+ when add_nl $ hPutChar handle '\n' (LineBuffering, buf) -> do- writeBlocks handle True nl buf str+ writeBlocks handle True add_nl nl buf str (BlockBuffering _, buf) -> do- writeBlocks handle False nl buf str+ writeBlocks handle False add_nl nl buf str hPutChars :: Handle -> [Char] -> IO () hPutChars _ [] = return ()@@ -540,19 +547,20 @@ -- NB. performance-critical code: eyeball the Core.-writeBlocks :: Handle -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()-writeBlocks hdl line_buffered nl+writeBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()+writeBlocks hdl line_buffered add_nl nl buf@Buffer{ bufRaw=raw, bufSize=len } s = let- shoveString :: Int -> [Char] -> IO ()- shoveString !n [] = do- _ <- commitBuffer hdl raw len n False{-no flush-} True{-release-}- return ()- shoveString !n (c:cs)+ shoveString :: Int -> [Char] -> [Char] -> IO ()+ shoveString !n [] [] = do+ commitBuffer hdl raw len n False{-no flush-} True{-release-}+ shoveString !n [] rest = do+ shoveString n rest []+ shoveString !n (c:cs) rest -- n+1 so we have enough room to write '\r\n' if necessary | n + 1 >= len = do- new_buf <- commitBuffer hdl raw len n True{-needs flush-} False- writeBlocks hdl line_buffered nl new_buf (c:cs)+ commitBuffer hdl raw len n False{-flush-} False+ shoveString 0 (c:cs) rest | c == '\n' = do n' <- if nl == CRLF then do @@ -562,36 +570,22 @@ writeCharBuf raw n c if line_buffered then do- new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False- writeBlocks hdl line_buffered nl new_buf cs+ -- end of line, so write and flush+ commitBuffer hdl raw len n' True{-flush-} False+ shoveString 0 cs rest else do- shoveString n' cs+ shoveString n' cs rest | otherwise = do n' <- writeCharBuf raw n c- shoveString n' cs+ shoveString n' cs rest in- shoveString 0 s+ shoveString 0 s (if add_nl then "\n" else "") -- ----------------------------------------------------------------------------- -- commitBuffer handle buf sz count flush release -- -- Write the contents of the buffer 'buf' ('sz' bytes long, containing -- 'count' bytes of data) to handle (handle must be block or line buffered).--- --- Implementation:--- --- for block/line buffering,--- 1. If there isn't room in the handle buffer, flush the handle--- buffer.--- --- 2. If the handle buffer is empty,--- if flush, --- then write buf directly to the device.--- else swap the handle buffer with buf.--- --- 3. If the handle buffer is non-empty, copy buf into the--- handle buffer. Then, if flush != 0, flush--- the buffer. commitBuffer :: Handle -- handle to commit to@@ -599,94 +593,53 @@ -> Int -- number of bytes of data in buffer -> Bool -- True <=> flush the handle afterward -> Bool -- release the buffer?- -> IO CharBuffer+ -> IO () commitBuffer hdl !raw !sz !count flush release = - wantWritableHandle "commitAndReleaseBuffer" hdl $- commitBuffer' raw sz count flush release-{-# NOINLINE commitBuffer #-}---- Explicitly lambda-lift this function to subvert GHC's full laziness--- optimisations, which otherwise tends to float out subexpressions--- past the \handle, which is really a pessimisation in this case because--- that lambda is a one-shot lambda.------ Don't forget to export the function, to stop it being inlined too--- (this appears to be better than NOINLINE, because the strictness--- analyser still gets to worker-wrapper it).------ This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001----commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__- -> IO CharBuffer-commitBuffer' raw sz@(I# _) count@(I# _) flush release- handle_@Handle__{ haCharBuffer=ref, haBuffers=spare_buf_ref } = do-+ wantWritableHandle "commitBuffer" hdl $ \h_@Handle__{..} -> do debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count ++ ", flush=" ++ show flush ++ ", release=" ++ show release) - old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }- <- readIORef ref+ writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer,+ bufL=0, bufR=count, bufSize=sz } - buf_ret <-- -- enough room in handle buffer?- if (not flush && (size - w > count))- -- The > is to be sure that we never exactly fill- -- up the buffer, which would require a flush. So- -- if copying the new data into the buffer would- -- make the buffer full, we just flush the existing- -- buffer and the new data immediately, rather than- -- copying before flushing.+ when flush $ flushByteWriteBuffer h_ - -- not flushing, and there's enough room in the buffer:- -- just copy the data in and update bufR.- then do withRawBuffer raw $ \praw ->- copyToRawBuffer old_raw (w*charSize)- praw (fromIntegral (count*charSize))- writeIORef ref old_buf{ bufR = w + count }- return (emptyBuffer raw sz WriteBuffer)+ -- release the buffer if necessary+ when release $ do+ -- find size of current buffer+ old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer+ when (sz == size) $ do+ spare_bufs <- readIORef haBuffers+ writeIORef haBuffers (BufferListCons raw spare_bufs) - -- else, we have to flush- else do flushed_buf <- flushWriteBuffer_ handle_ old_buf+ return () - let this_buf = - Buffer{ bufRaw=raw, bufState=WriteBuffer, - bufL=0, bufR=count, bufSize=sz }+-- backwards compatibility; the text package uses this+commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__+ -> IO CharBuffer+commitBuffer' raw sz@(I# _) count@(I# _) flush release h_@Handle__{..}+ = do+ debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count+ ++ ", flush=" ++ show flush ++ ", release=" ++ show release) - -- if: (a) we don't have to flush, and- -- (b) size(new buffer) == size(old buffer), and- -- (c) new buffer is not full,- -- we can just just swap them over...- if (not flush && sz == size && count /= sz)- then do - writeIORef ref this_buf- return flushed_buf + let this_buf = Buffer{ bufRaw=raw, bufState=WriteBuffer,+ bufL=0, bufR=count, bufSize=sz } - -- otherwise, we have to flush the new data too,- -- and start with a fresh buffer- else do- -- We're aren't going to use this buffer again- -- so we ignore the result of flushWriteBuffer_- _ <- flushWriteBuffer_ handle_ this_buf- writeIORef ref flushed_buf- -- if the sizes were different, then allocate- -- a new buffer of the correct size.- if sz == size- then return (emptyBuffer raw sz WriteBuffer)- else newCharBuffer size WriteBuffer+ writeCharBuffer h_ this_buf + when flush $ flushByteWriteBuffer h_+ -- release the buffer if necessary- case buf_ret of- Buffer{ bufSize=buf_ret_sz, bufRaw=buf_ret_raw } -> do- if release && buf_ret_sz == size- then do- spare_bufs <- readIORef spare_buf_ref- writeIORef spare_buf_ref - (BufferListCons buf_ret_raw spare_bufs)- return buf_ret- else- return buf_ret+ when release $ do+ -- find size of current buffer+ old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer+ when (sz == size) $ do+ spare_bufs <- readIORef haBuffers+ writeIORef haBuffers (BufferListCons raw spare_bufs) + return this_buf+ -- --------------------------------------------------------------------------- -- Reading/writing sequences of bytes. @@ -735,10 +688,6 @@ wantWritableHandle "hPutBuf" handle $ \ h_@Handle__{..} -> do debugIO ("hPutBuf count=" ++ show count)- -- first flush the Char buffer if it is non-empty, then we- -- can work directly with the byte buffer- cbuf <- readIORef haCharBuffer- when (not (isEmptyBuffer cbuf)) $ flushWriteBuffer h_ r <- bufWrite h_ (castPtr ptr) count can_block @@ -761,7 +710,7 @@ -- There's enough room in the buffer: -- just copy the data in and update bufR. then do debugIO ("hPutBuf: copying to buffer, w=" ++ show w)- copyToRawBuffer old_raw w ptr (fromIntegral count)+ copyToRawBuffer old_raw w ptr count writeIORef haByteBuffer old_buf{ bufR = w + count } return count @@ -836,7 +785,7 @@ return (so_far + count) else do - copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail)+ copyFromRawBuffer ptr raw r avail let buf' = buf{ bufR=0, bufL=0 } writeIORef haByteBuffer buf' let remaining = count - avail@@ -863,7 +812,7 @@ loop :: FD -> Int -> Int -> IO Int loop fd off bytes | bytes <= 0 = return (so_far + off) loop fd off bytes = do- r <- RawIO.read (fd::FD) (ptr `plusPtr` off) (fromIntegral bytes)+ r <- RawIO.read (fd::FD) (ptr `plusPtr` off) bytes if r == 0 then return (so_far + off) else loop fd (off + r) (bytes - r)@@ -908,7 +857,7 @@ -- that bufReadNBNonEmpty will not -- issue another read. else- bufReadNBEmpty h_ buf (castPtr ptr) 0 count+ bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count haFD :: Handle__ -> FD haFD h_@Handle__{..} =@@ -987,7 +936,7 @@ return (so_far + count) else do - copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail)+ copyFromRawBuffer ptr raw r avail let buf' = buf{ bufR=0, bufL=0 } writeIORef haByteBuffer buf' let remaining = count - avail
GHC/IO/Handle/Types.hs view
@@ -41,6 +41,9 @@ import GHC.Word import GHC.IO.Device import Data.Typeable+#ifdef DEBUG+import Control.Monad+#endif -- --------------------------------------------------------------------------- -- Handle type@@ -179,6 +182,13 @@ checkBuffer bbuf cbuf <- readIORef (haCharBuffer h_) checkBuffer cbuf+ when (isWriteBuffer cbuf && not (isEmptyBuffer cbuf)) $+ error ("checkHandleInvariants: char write buffer non-empty: " +++ summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)+ when (isWriteBuffer bbuf /= isWriteBuffer cbuf) $+ error ("checkHandleInvariants: buffer modes differ: " +++ summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)+ #else checkHandleInvariants _ = return () #endif@@ -257,26 +267,47 @@ [note Buffered Writing] -Characters are written into the Char buffer by e.g. hPutStr. When the-buffer is full, we call writeTextDevice, which encodes the Char buffer-into the byte buffer, and then immediately writes it all out to the-underlying device. The Char buffer will always be empty afterward.-This might require multiple decoding/writing cycles.+Characters are written into the Char buffer by e.g. hPutStr. At the+end of the operation, or when the char buffer is full, the buffer is+decoded to the byte buffer (see writeCharBuffer). This is so that we+can detect encoding errors at the right point. +Hence, the Char buffer is always empty between Handle operations.+ [note Buffer Sizing] -Since the buffer mode makes no difference when reading, we can just-use the default buffer size for both the byte and the Char buffer.-Ineed, we must have room for at least one Char in the Char buffer,-because we have to implement hLookAhead, which requires caching a Char-in the Handle. Furthermore, when doing newline translation, we need-room for at least two Chars in the read buffer, so we can spot the-\r\n sequence.+The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE).+The byte buffer size is chosen by the underlying device (via its+IODevice.newBuffer). Hence the size of these buffers is not under+user control. -For writing, however, when the buffer mode is NoBuffering, we use a-1-element Char buffer to force flushing of the buffer after each Char-is read.+There are certain minimum sizes for these buffers imposed by the+library (but not checked): + - we must be able to buffer at least one character, so that+ hLookAhead can work++ - the byte buffer must be able to store at least one encoded+ character in the current encoding (6 bytes?)++ - when reading, the char buffer must have room for two characters, so+ that we can spot the \r\n sequence.++How do we implement hSetBuffering?++For reading, we have never used the user-supplied buffer size, because+there's no point: we always pass all available data to the reader+immediately. Buffering would imply waiting until a certain amount of+data is available, which has no advantages. So hSetBuffering is+essentially a no-op for read handles, except that it turns on/off raw+mode for the underlying device if necessary.++For writing, the buffering mode is handled by the write operations+themselves (hPutChar and hPutStr). Every write ends with+writeCharBuffer, which checks whether the buffer should be flushed+according to the current buffering mode. Additionally, we look for+newlines and flush if the mode is LineBuffering.+ [note Buffer Flushing] ** Flushing the Char buffer@@ -284,8 +315,7 @@ We must be able to flush the Char buffer, in order to implement hSetEncoding, and things like hGetBuf which want to read raw bytes. -Flushing the Char buffer on a write Handle is easy: just call-writeTextDevice to encode and write the date.+Flushing the Char buffer on a write Handle is easy: it is always empty. Flushing the Char buffer on a read Handle involves rewinding the byte buffer to the point representing the next Char in the Char buffer.
GHC/Num.lhs view
@@ -111,6 +111,7 @@ | n `eqInt` 0 = 0 | otherwise = 1 + {-# INLINE fromInteger #-} -- Just to be sure! fromInteger i = I# (toInt# i) quotRemInt :: Int -> Int -> (Int, Int)
GHC/Real.lhs view
@@ -424,6 +424,7 @@ Integer -> Integer -> Integer, Integer -> Int -> Integer, Int -> Int -> Int #-}+{-# INLINABLE (^) #-} -- See Note [Inlining (^)] (^) :: (Num a, Integral b) => a -> b -> a x0 ^ y0 | y0 < 0 = error "Negative exponent" | y0 == 0 = 1@@ -439,7 +440,19 @@ -- | raise a number to an integral power (^^) :: (Fractional a, Integral b) => a -> b -> a+{-# INLINABLE (^^) #-} -- See Note [Inlining (^) x ^^ n = if n >= 0 then x^n else recip (x^(negate n))++{- Note [Inlining (^)+ ~~~~~~~~~~~~~~~~~~~~~+ The INLINABLE pragma allows (^) to be specialised at its call sites.+ If it is called repeatedly at the same type, that can make a huge+ difference, because of those constants which can be repeatedly+ calculated.++ Currently the fromInteger calls are not floated because we get+ \d1 d2 x y -> blah+ after the gentle round of simplification. -} ------------------------------------------------------- -- Special power functions for Rational
System/Event.hs view
@@ -1,3 +1,7 @@+-- | This module provides scalable event notification for file+-- descriptors and timeouts.+--+-- This module should be considered GHC internal. module System.Event ( -- * Types EventManager@@ -22,7 +26,7 @@ , registerFd_ , unregisterFd , unregisterFd_- , fdWasClosed+ , closeFd -- * Registering interest in timeout events , TimeoutCallback
System/Event/Internal.hs view
@@ -12,6 +12,7 @@ , Event , evtRead , evtWrite+ , evtClose , eventIs -- * Timeout type , Timeout(..)@@ -29,7 +30,7 @@ import GHC.Show (Show(..)) import GHC.List (filter, null) --- | An I/O event.+-- | An I\/O event. newtype Event = Event Int deriving (Eq) @@ -37,20 +38,29 @@ evtNothing = Event 0 {-# INLINE evtNothing #-} +-- | Data is available to be read. evtRead :: Event evtRead = Event 1 {-# INLINE evtRead #-} +-- | The file descriptor is ready to accept a write. evtWrite :: Event evtWrite = Event 2 {-# INLINE evtWrite #-} +-- | Another thread closed the file descriptor.+evtClose :: Event+evtClose = Event 4+{-# INLINE evtClose #-}+ eventIs :: Event -> Event -> Bool eventIs (Event a) (Event b) = a .&. b /= 0 instance Show Event where show e = '[' : (intercalate "," . filter (not . null) $- [evtRead `so` "evtRead", evtWrite `so` "evtWrite"]) ++ "]"+ [evtRead `so` "evtRead",+ evtWrite `so` "evtWrite",+ evtClose `so` "evtClose"]) ++ "]" where ev `so` disp | e `eventIs` ev = disp | otherwise = ""
System/Event/KQueue.hsc view
@@ -278,7 +278,7 @@ toEvent (Filter f) | f == (#const EVFILT_READ) = E.evtRead | f == (#const EVFILT_WRITE) = E.evtWrite- | otherwise = error $ "toEvent: unknonwn filter " ++ show f+ | otherwise = error $ "toEvent: unknown filter " ++ show f foreign import ccall unsafe "kqueue" c_kqueue :: IO CInt
System/Event/Manager.hs view
@@ -14,6 +14,7 @@ , loop , step , shutdown+ , cleanup , wakeManager -- * Registering interest in I/O events@@ -26,7 +27,7 @@ , registerFd , unregisterFd_ , unregisterFd- , fdWasClosed+ , closeFd -- * Registering interest in timeout events , TimeoutCallback@@ -41,14 +42,13 @@ ------------------------------------------------------------------------ -- Imports -import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar,- readMVar)+import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, readMVar) import Control.Exception (finally) import Control.Monad ((=<<), forM_, liftM, sequence_, when) import Data.IORef (IORef, atomicModifyIORef, mkWeakIORef, newIORef, readIORef, writeIORef) import Data.Maybe (Maybe(..))-import Data.Monoid (mconcat, mempty)+import Data.Monoid (mappend, mconcat, mempty) import GHC.Base import GHC.Conc.Signal (runHandlers) import GHC.List (filter)@@ -57,7 +57,8 @@ import GHC.Show (Show(..)) import System.Event.Clock (getCurrentTime) import System.Event.Control-import System.Event.Internal (Backend, Event, evtRead, evtWrite, Timeout(..))+import System.Event.Internal (Backend, Event, evtClose, evtRead, evtWrite,+ Timeout(..)) import System.Event.Unique (Unique, UniqueSource, newSource, newUnique) import System.Posix.Types (Fd) @@ -96,6 +97,7 @@ instance Show IOCallback where show _ = "IOCallback" +-- | A timeout registration cookie. newtype TimeoutKey = TK Unique deriving (Eq) @@ -217,7 +219,8 @@ ------------------------------------------------------------------------ -- Event loop --- | Start handling events. This function loops until told to stop.+-- | Start handling events. This function loops until told to stop,+-- using 'shutdown'. -- -- /Note/: This loop can only be run once per 'EventManager', as it -- closes all of its control resources when it finishes.@@ -331,20 +334,25 @@ wake <- unregisterFd_ mgr reg when wake $ wakeManager mgr --- | Notify the event manager that a file descriptor has been closed.-fdWasClosed :: EventManager -> Fd -> IO ()-fdWasClosed mgr fd =- modifyMVar_ (emFds mgr) $ \oldMap ->+-- | Close a file descriptor in a race-safe way.+closeFd :: EventManager -> (Fd -> IO ()) -> Fd -> IO ()+closeFd mgr close fd = do+ fds <- modifyMVar (emFds mgr) $ \oldMap -> do+ close fd case IM.delete (fromIntegral fd) oldMap of- (Nothing, _) -> return oldMap+ (Nothing, _) -> return (oldMap, []) (Just fds, !newMap) -> do when (eventsOf fds /= mempty) $ wakeManager mgr- return newMap+ return (newMap, fds)+ forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose) ------------------------------------------------------------------------ -- Registering interest in timeout events --- | Register a timeout in the given number of microseconds.+-- | Register a timeout in the given number of microseconds. The+-- returned 'TimeoutKey' can be used to later unregister or update the+-- timeout. The timeout is automatically unregistered after the given+-- time has passed. registerTimeout :: EventManager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout mgr us cb = do !key <- newUnique (emUniqueSource mgr)@@ -363,12 +371,15 @@ wakeManager mgr return $ TK key +-- | Unregister an active timeout. unregisterTimeout :: EventManager -> TimeoutKey -> IO () unregisterTimeout mgr (TK key) = do atomicModifyIORef (emTimeouts mgr) $ \f -> let f' = (Q.delete key) . f in (f', ()) wakeManager mgr +-- | Update an active timeout to fire in the given number of+-- microseconds. updateTimeout :: EventManager -> TimeoutKey -> Int -> IO () updateTimeout mgr (TK key) us = do now <- getCurrentTime
System/Event/Thread.hs view
@@ -5,20 +5,26 @@ ensureIOManagerIsRunning , threadWaitRead , threadWaitWrite+ , closeFdWith , threadDelay , registerDelay ) where import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (Maybe(..))+import Foreign.C.Error (eBADF, errnoToIOError) import Foreign.Ptr (Ptr) import GHC.Base import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, newTVar, sharedCAF, threadStatus, writeTVar)+import GHC.IO (mask_, onException)+import GHC.IO.Exception (ioError) import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)+import System.Event.Internal (eventIs, evtClose) import System.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_, registerTimeout)+import qualified System.Event.Manager as M import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (Fd) @@ -29,11 +35,11 @@ -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. threadDelay :: Int -> IO ()-threadDelay usecs = do+threadDelay usecs = mask_ $ do Just mgr <- readIORef eventManager m <- newEmptyMVar- _ <- registerTimeout mgr usecs (putMVar m ())- takeMVar m+ reg <- registerTimeout mgr usecs (putMVar m ())+ takeMVar m `onException` M.unregisterTimeout mgr reg -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply.@@ -47,22 +53,45 @@ -- | Block the current thread until data is available to read from the -- given file descriptor.+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked. To safely close a file descriptor+-- that has been used with 'threadWaitRead', use 'closeFdWith'. threadWaitRead :: Fd -> IO () threadWaitRead = threadWait evtRead {-# INLINE threadWaitRead #-} -- | Block the current thread until the given file descriptor can -- accept data to write.+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked. To safely close a file descriptor+-- that has been used with 'threadWaitWrite', use 'closeFdWith'. threadWaitWrite :: Fd -> IO () threadWaitWrite = threadWait evtWrite {-# INLINE threadWaitWrite #-} +-- | Close a file descriptor in a concurrency-safe way.+--+-- Any threads that are blocked on the file descriptor via+-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having+-- IO exceptions thrown.+closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close.+ -> Fd -- ^ File descriptor to close.+ -> IO ()+closeFdWith close fd = do+ Just mgr <- readIORef eventManager+ M.closeFd mgr close fd+ threadWait :: Event -> Fd -> IO ()-threadWait evt fd = do+threadWait evt fd = mask_ $ do m <- newEmptyMVar Just mgr <- readIORef eventManager- _ <- registerFd mgr (\reg _ -> unregisterFd_ mgr reg >> putMVar m ()) fd evt- takeMVar m+ reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt+ evt' <- takeMVar m `onException` unregisterFd_ mgr reg+ if evt' `eventIs` evtClose+ then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing+ else return () foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)@@ -98,7 +127,17 @@ s <- threadStatus t case s of ThreadFinished -> create- ThreadDied -> create+ ThreadDied -> do + -- Sanity check: if the thread has died, there is a chance+ -- that event manager is still alive. This could happend during+ -- the fork, for example. In this case we should clean up+ -- open pipes and everything else related to the event manager.+ -- See #4449+ mem <- readIORef eventManager+ _ <- case mem of+ Nothing -> return ()+ Just em -> M.cleanup em+ create _other -> return st foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
System/IO.hs view
@@ -244,13 +244,12 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.Real import GHC.IO hiding ( onException ) import GHC.IO.IOMode import GHC.IO.Handle.FD import qualified GHC.IO.FD as FD import GHC.IO.Handle-import GHC.IO.Handle.Text ( hGetBufSome )+import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn ) import GHC.IORef import GHC.IO.Exception ( userError ) import GHC.IO.Encoding@@ -326,8 +325,7 @@ -- | The same as 'putStr', but adds a newline character. putStrLn :: String -> IO ()-putStrLn s = do putStr s- putChar '\n'+putStrLn s = hPutStrLn stdout s -- | The 'print' function outputs a value of any printable type to the -- standard output device.@@ -425,13 +423,6 @@ hReady :: Handle -> IO Bool hReady h = hWaitForInput h 0 --- | The same as 'hPutStr', but adds a newline character.--hPutStrLn :: Handle -> String -> IO ()-hPutStrLn hndl str = do- hPutStr hndl str- hPutChar hndl '\n'- -- | Computation 'hPrint' @hdl t@ writes the string representation of @t@ -- given by the 'shows' function to the file or channel managed by @hdl@ -- and appends a newline.@@ -575,7 +566,7 @@ else ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) else do - (fD,fd_type) <- FD.mkFD (fromIntegral fd) ReadWriteMode Nothing{-no stat-}+ (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-} False{-is_socket-} True{-is_nonblock-}
System/Mem/Weak.hs view
@@ -67,13 +67,16 @@ -- $precise ) where -import Prelude+import Data.Maybe (Maybe(..)) #ifdef __HUGS__ import Hugs.Weak+import Prelude #endif #ifdef __GLASGOW_HASKELL__+import GHC.Base (return)+import GHC.Types (IO) import GHC.Weak #endif
base.cabal view
@@ -1,5 +1,5 @@ name: base-version: 4.3.0.0+version: 4.3.1.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org
configure view
@@ -1,13 +1,13 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.65 for Haskell base package 1.0.+# Generated by GNU Autoconf 2.67 for Haskell base package 1.0. # # Report bugs to <libraries@haskell.org>. # # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,-# Inc.+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software+# Foundation, Inc. # # # This configure script is free software; the Free Software Foundation@@ -319,7 +319,7 @@ test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs"- } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p@@ -359,19 +359,19 @@ fi # as_fn_arith -# as_fn_error ERROR [LINENO LOG_FD]-# ---------------------------------+# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the-# script with status $?, using 1 if that was 0.+# script with STATUS, using 1 if that was 0. as_fn_error () {- as_status=$?; test $as_status -eq 0 && as_status=1- if test "$3"; then- as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack- $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3+ as_status=$1; test $as_status -eq 0 && as_status=1+ if test "$4"; then+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi- $as_echo "$as_me: error: $1" >&2+ $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error @@ -533,7 +533,7 @@ exec 6>&1 # Name of the host.-# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` @@ -726,8 +726,9 @@ fi case $ac_option in- *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;- *) ac_optarg=yes ;;+ *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;+ *=) ac_optarg= ;;+ *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos.@@ -772,7 +773,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error "invalid feature name: $ac_useropt"+ as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in@@ -798,7 +799,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error "invalid feature name: $ac_useropt"+ as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in@@ -1002,7 +1003,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error "invalid package name: $ac_useropt"+ as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in@@ -1018,7 +1019,7 @@ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error "invalid package name: $ac_useropt"+ as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in@@ -1048,8 +1049,8 @@ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error "unrecognized option: \`$ac_option'-Try \`$0 --help' for more information."+ -*) as_fn_error $? "unrecognized option: \`$ac_option'+Try \`$0 --help' for more information" ;; *=*)@@ -1057,7 +1058,7 @@ # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* )- as_fn_error "invalid variable name: \`$ac_envvar'" ;;+ as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;;@@ -1075,13 +1076,13 @@ if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'`- as_fn_error "missing argument to $ac_option"+ as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;;- fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;;+ fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi@@ -1104,7 +1105,7 @@ [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac- as_fn_error "expected an absolute directory name for --$ac_var: $ac_val"+ as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host'@@ -1118,8 +1119,8 @@ if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe- $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.- If a cross compiler is detected then cross compile mode will be used." >&2+ $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.+ If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi@@ -1134,9 +1135,9 @@ ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||- as_fn_error "working directory cannot be determined"+ as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||- as_fn_error "pwd does not report name of working directory"+ as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified.@@ -1175,11 +1176,11 @@ fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."- as_fn_error "cannot find sources ($ac_unique_file) in $srcdir"+ as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`(- cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg"+ cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then@@ -1219,7 +1220,7 @@ --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit- -q, --quiet, --silent do not print \`checking...' messages+ -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files@@ -1360,9 +1361,9 @@ if $ac_init_version; then cat <<\_ACEOF Haskell base package configure 1.0-generated by GNU Autoconf 2.65+generated by GNU Autoconf 2.67 -Copyright (C) 2009 Free Software Foundation, Inc.+Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF@@ -1420,7 +1421,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :+if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else eval "$3=no"@@ -1486,7 +1487,7 @@ mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5- test $ac_status = 0; } >/dev/null && {+ test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then :@@ -1553,7 +1554,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :+if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -1583,10 +1584,10 @@ ac_fn_c_check_header_mongrel () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack- if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :+ if eval "test \"\${$3+set}\"" = set; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :+if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 fi eval ac_res=\$$3@@ -1622,7 +1623,7 @@ else ac_header_preproc=no fi-rm -f conftest.err conftest.$ac_ext+rm -f conftest.err conftest.i conftest.$ac_ext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 $as_echo "$ac_header_preproc" >&6; } @@ -1645,17 +1646,15 @@ $as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 $as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}-( cat <<\_ASBOX-## ------------------------------------ ##+( $as_echo "## ------------------------------------ ## ## Report this to libraries@haskell.org ##-## ------------------------------------ ##-_ASBOX+## ------------------------------------ ##" ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :+if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else eval "$3=\$ac_header_compiler"@@ -1722,7 +1721,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :+if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -1963,7 +1962,7 @@ running configure, to aid debugging if configure makes a mistake. It was created by Haskell base package $as_me 1.0, which was-generated by GNU Autoconf 2.65. Invocation command line was+generated by GNU Autoconf 2.67. Invocation command line was $ $0 $@ @@ -2073,11 +2072,9 @@ { echo - cat <<\_ASBOX-## ---------------- ##+ $as_echo "## ---------------- ## ## Cache variables. ##-## ---------------- ##-_ASBOX+## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, (@@ -2111,11 +2108,9 @@ ) echo - cat <<\_ASBOX-## ----------------- ##+ $as_echo "## ----------------- ## ## Output variables. ##-## ----------------- ##-_ASBOX+## ----------------- ##" echo for ac_var in $ac_subst_vars do@@ -2128,11 +2123,9 @@ echo if test -n "$ac_subst_files"; then- cat <<\_ASBOX-## ------------------- ##+ $as_echo "## ------------------- ## ## File substitutions. ##-## ------------------- ##-_ASBOX+## ------------------- ##" echo for ac_var in $ac_subst_files do@@ -2146,11 +2139,9 @@ fi if test -s confdefs.h; then- cat <<\_ASBOX-## ----------- ##+ $as_echo "## ----------- ## ## confdefs.h. ##-## ----------- ##-_ASBOX+## ----------- ##" echo cat confdefs.h echo@@ -2205,7 +2196,12 @@ ac_site_file1=NONE ac_site_file2=NONE if test -n "$CONFIG_SITE"; then- ac_site_file1=$CONFIG_SITE+ # We do not want a PATH search for config.site.+ case $CONFIG_SITE in #((+ -*) ac_site_file1=./$CONFIG_SITE;;+ */*) ac_site_file1=$CONFIG_SITE;;+ *) ac_site_file1=./$CONFIG_SITE;;+ esac elif test "x$prefix" != xNONE; then ac_site_file1=$prefix/share/config.site ac_site_file2=$prefix/etc/config.site@@ -2220,7 +2216,11 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 $as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5- . "$ac_site_file"+ . "$ac_site_file" \+ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "failed to load site script $ac_site_file+See \`config.log' for more details" "$LINENO" 5 ; } fi done @@ -2296,7 +2296,7 @@ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 $as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}- as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5+ as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ##@@ -2622,8 +2622,8 @@ test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error "no acceptable C compiler found in \$PATH-See \`config.log' for more details." "$LINENO" 5; }+as_fn_error $? "no acceptable C compiler found in \$PATH+See \`config.log' for more details" "$LINENO" 5 ; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5@@ -2737,9 +2737,8 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ as_fn_set_status 77-as_fn_error "C compiler cannot create executables-See \`config.log' for more details." "$LINENO" 5; }; }+as_fn_error 77 "C compiler cannot create executables+See \`config.log' for more details" "$LINENO" 5 ; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; }@@ -2781,8 +2780,8 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error "cannot compute suffix of executables: cannot compile and link-See \`config.log' for more details." "$LINENO" 5; }+as_fn_error $? "cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details" "$LINENO" 5 ; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5@@ -2839,9 +2838,9 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error "cannot run C compiled programs.+as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'.-See \`config.log' for more details." "$LINENO" 5; }+See \`config.log' for more details" "$LINENO" 5 ; } fi fi fi@@ -2892,8 +2891,8 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error "cannot compute suffix of object files: cannot compile-See \`config.log' for more details." "$LINENO" 5; }+as_fn_error $? "cannot compute suffix of object files: cannot compile+See \`config.log' for more details" "$LINENO" 5 ; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi@@ -3158,7 +3157,7 @@ # Broken: fails on valid input. continue fi-rm -f conftest.err conftest.$ac_ext+rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how.@@ -3174,11 +3173,11 @@ ac_preproc_ok=: break fi-rm -f conftest.err conftest.$ac_ext+rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.err conftest.$ac_ext+rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi@@ -3217,7 +3216,7 @@ # Broken: fails on valid input. continue fi-rm -f conftest.err conftest.$ac_ext+rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how.@@ -3233,18 +3232,18 @@ ac_preproc_ok=: break fi-rm -f conftest.err conftest.$ac_ext+rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.err conftest.$ac_ext+rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error "C preprocessor \"$CPP\" fails sanity check-See \`config.log' for more details." "$LINENO" 5; }+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check+See \`config.log' for more details" "$LINENO" 5 ; } fi ac_ext=c@@ -3305,7 +3304,7 @@ done IFS=$as_save_IFS if test -z "$ac_cv_path_GREP"; then- as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5+ as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_GREP=$GREP@@ -3371,7 +3370,7 @@ done IFS=$as_save_IFS if test -z "$ac_cv_path_EGREP"; then- as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5+ as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_EGREP=$EGREP@@ -3503,8 +3502,7 @@ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default "-eval as_val=\$$as_ac_Header- if test "x$as_val" = x""yes; then :+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF@@ -3643,8 +3641,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"-eval as_val=\$$as_ac_Header- if test "x$as_val" = x""yes; then :+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF@@ -3893,8 +3890,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"-eval as_val=\$$as_ac_var- if test "x$as_val" = x""yes; then :+if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF@@ -3906,8 +3902,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"-eval as_val=\$$as_ac_var- if test "x$as_val" = x""yes; then :+if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF@@ -3920,8 +3915,7 @@ do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"-eval as_val=\$$as_ac_var- if test "x$as_val" = x""yes; then :+if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF@@ -8654,7 +8648,7 @@ as_fp_Cache=`$as_echo "fp_cv_const_$fp_const_name" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking value of $fp_const_name" >&5 $as_echo_n "checking value of $fp_const_name... " >&6; }-if { as_var=$as_fp_Cache; eval "test \"\${$as_var+set}\" = set"; }; then :+if eval "test \"\${$as_fp_Cache+set}\"" = set; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "$fp_const_name" "fp_check_const_result" "#include <stdio.h>@@ -8684,7 +8678,7 @@ as_fp_Cache=`$as_echo "fp_cv_const_$fp_const_name" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking value of $fp_const_name" >&5 $as_echo_n "checking value of $fp_const_name... " >&6; }-if { as_var=$as_fp_Cache; eval "test \"\${$as_var+set}\" = set"; }; then :+if eval "test \"\${$as_fp_Cache+set}\"" = set; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "$fp_const_name" "fp_check_const_result" "@@ -8793,7 +8787,7 @@ case `uname -s` in MINGW*|CYGWIN*) ;; *)- as_fn_error "iconv is required on non-Windows platforms" "$LINENO" 5;;+ as_fn_error $? "iconv is required on non-Windows platforms" "$LINENO" 5 ;; esac fi @@ -8939,6 +8933,7 @@ ac_libobjs= ac_ltlibobjs=+U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'@@ -9100,19 +9095,19 @@ (unset CDPATH) >/dev/null 2>&1 && unset CDPATH -# as_fn_error ERROR [LINENO LOG_FD]-# ---------------------------------+# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the-# script with status $?, using 1 if that was 0.+# script with STATUS, using 1 if that was 0. as_fn_error () {- as_status=$?; test $as_status -eq 0 && as_status=1- if test "$3"; then- as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack- $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3+ as_status=$1; test $as_status -eq 0 && as_status=1+ if test "$4"; then+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi- $as_echo "$as_me: error: $1" >&2+ $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error @@ -9308,7 +9303,7 @@ test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs"- } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p@@ -9362,7 +9357,7 @@ # values after options handling. ac_log=" This file was extended by Haskell base package $as_me 1.0, which was-generated by GNU Autoconf 2.65. Invocation command line was+generated by GNU Autoconf 2.67. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS@@ -9424,10 +9419,10 @@ ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ Haskell base package config.status 1.0-configured by $0, generated by GNU Autoconf 2.65,+configured by $0, generated by GNU Autoconf 2.67, with options \\"\$ac_cs_config\\" -Copyright (C) 2009 Free Software Foundation, Inc.+Copyright (C) 2010 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -9442,11 +9437,16 @@ while test $# != 0 do case $1 in- --*=*)+ --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;;+ --*=)+ ac_option=`expr "X$1" : 'X\([^=]*\)='`+ ac_optarg=+ ac_shift=:+ ;; *) ac_option=$1 ac_optarg=$2@@ -9468,6 +9468,7 @@ $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+ '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;;@@ -9480,7 +9481,7 @@ ac_need_defaults=false;; --he | --h) # Conflict between --help and --header- as_fn_error "ambiguous option: \`$1'+ as_fn_error $? "ambiguous option: \`$1' Try \`$0 --help' for more information.";; --help | --hel | -h ) $as_echo "$ac_cs_usage"; exit ;;@@ -9489,7 +9490,7 @@ ac_cs_silent=: ;; # This is an error.- -*) as_fn_error "unrecognized option: \`$1'+ -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1"@@ -9542,7 +9543,7 @@ "include/EventConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/EventConfig.h" ;; "base.buildinfo") CONFIG_FILES="$CONFIG_FILES base.buildinfo" ;; - *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;;+ *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;; esac done @@ -9579,7 +9580,7 @@ { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp")-} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES.@@ -9596,7 +9597,7 @@ fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then- ac_cs_awk_cr='\r'+ ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi@@ -9610,18 +9611,18 @@ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh ||- as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5-ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'`+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh ||- as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then- as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi@@ -9710,20 +9711,28 @@ else cat fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \- || as_fn_error "could not setup config files machinery" "$LINENO" 5+ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF -# VPATH may cause trouble with some makes, so we remove $(srcdir),-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and+# VPATH may cause trouble with some makes, so we remove sole $(srcdir),+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then- ac_vpsub='/^[ ]*VPATH[ ]*=/{-s/:*\$(srcdir):*/:/-s/:*\${srcdir}:*/:/-s/:*@srcdir@:*/:/-s/^\([^=]*=[ ]*\):*/\1/+ ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{+h+s///+s/^/:/+s/[ ]*$/:/+s/:\$(srcdir):/:/g+s/:\${srcdir}:/:/g+s/:@srcdir@:/:/g+s/^:*// s/:*$//+x+s/\(=[ ]*\).*/\1/+G+s/\n// s/^[^=]*=[ ]*$// }' fi@@ -9751,7 +9760,7 @@ if test -z "$ac_t"; then break elif $ac_last_try; then- as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5+ as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi@@ -9836,7 +9845,7 @@ _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1- as_fn_error "could not setup config headers machinery" "$LINENO" 5+ as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 fi # test -n "$CONFIG_HEADERS" @@ -9849,7 +9858,7 @@ esac case $ac_mode$ac_tag in :[FHL]*:*);;- :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;;+ :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5 ;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac@@ -9877,7 +9886,7 @@ [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac ||- as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;;+ as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5 ;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'"@@ -9904,7 +9913,7 @@ case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin" \- || as_fn_error "could not create $ac_file" "$LINENO" 5 ;;+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac@@ -10030,22 +10039,22 @@ $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \- || as_fn_error "could not create $ac_file" "$LINENO" 5+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined. Please make sure it is defined." >&5+which seems to be undefined. Please make sure it is defined" >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined. Please make sure it is defined." >&2;}+which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out" && rm -f "$tmp/out";; *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; esac \- || as_fn_error "could not create $ac_file" "$LINENO" 5+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; :H) #@@ -10056,19 +10065,19 @@ $as_echo "/* $configure_input */" \ && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" } >"$tmp/config.h" \- || as_fn_error "could not create $ac_file" "$LINENO" 5+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 $as_echo "$as_me: $ac_file is unchanged" >&6;} else rm -f "$ac_file" mv "$tmp/config.h" "$ac_file" \- || as_fn_error "could not create $ac_file" "$LINENO" 5+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 fi else $as_echo "/* $configure_input */" \ && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \- || as_fn_error "could not create -" "$LINENO" 5+ || as_fn_error $? "could not create -" "$LINENO" 5 fi ;; @@ -10083,7 +10092,7 @@ ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 ||- as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5+ as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status.@@ -10104,7 +10113,7 @@ exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction.- $ac_cs_success || as_fn_exit $?+ $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
include/HsBaseConfig.h view
@@ -464,7 +464,7 @@ #define HTYPE_CHAR Int8 /* Define to Haskell type for clock_t */-#define HTYPE_CLOCK_T Int32+#define HTYPE_CLOCK_T Int64 /* Define to Haskell type for dev_t */ #define HTYPE_DEV_T Word64@@ -488,10 +488,10 @@ #define HTYPE_INTMAX_T Int64 /* Define to Haskell type for intptr_t */-#define HTYPE_INTPTR_T Int32+#define HTYPE_INTPTR_T Int64 /* Define to Haskell type for long */-#define HTYPE_LONG Int32+#define HTYPE_LONG Int64 /* Define to Haskell type for long long */ #define HTYPE_LONG_LONG Int64@@ -500,7 +500,7 @@ #define HTYPE_MODE_T Word32 /* Define to Haskell type for nlink_t */-#define HTYPE_NLINK_T Word32+#define HTYPE_NLINK_T Word64 /* Define to Haskell type for off_t */ #define HTYPE_OFF_T Int64@@ -509,7 +509,7 @@ #define HTYPE_PID_T Int32 /* Define to Haskell type for ptrdiff_t */-#define HTYPE_PTRDIFF_T Int32+#define HTYPE_PTRDIFF_T Int64 /* Define to Haskell type for rlim_t */ #define HTYPE_RLIM_T Word64@@ -524,19 +524,19 @@ #define HTYPE_SIG_ATOMIC_T Int32 /* Define to Haskell type for size_t */-#define HTYPE_SIZE_T Word32+#define HTYPE_SIZE_T Word64 /* Define to Haskell type for speed_t */ #define HTYPE_SPEED_T Word32 /* Define to Haskell type for ssize_t */-#define HTYPE_SSIZE_T Int32+#define HTYPE_SSIZE_T Int64 /* Define to Haskell type for tcflag_t */ #define HTYPE_TCFLAG_T Word32 /* Define to Haskell type for time_t */-#define HTYPE_TIME_T Int32+#define HTYPE_TIME_T Int64 /* Define to Haskell type for uid_t */ #define HTYPE_UID_T Word32@@ -545,7 +545,7 @@ #define HTYPE_UINTMAX_T Word64 /* Define to Haskell type for uintptr_t */-#define HTYPE_UINTPTR_T Word32+#define HTYPE_UINTPTR_T Word64 /* Define to Haskell type for unsigned char */ #define HTYPE_UNSIGNED_CHAR Word8@@ -554,7 +554,7 @@ #define HTYPE_UNSIGNED_INT Word32 /* Define to Haskell type for unsigned long */-#define HTYPE_UNSIGNED_LONG Word32+#define HTYPE_UNSIGNED_LONG Word64 /* Define to Haskell type for unsigned long long */ #define HTYPE_UNSIGNED_LONG_LONG Word64@@ -590,7 +590,7 @@ #define STDC_HEADERS 1 /* Number of bits in a file offset, on hosts where this is settable. */-#define _FILE_OFFSET_BITS 64+/* #undef _FILE_OFFSET_BITS */ /* Define for large files, on AIX-style hosts. */ /* #undef _LARGE_FILES */