packages feed

base 4.2.0.0 → 4.2.0.1

raw patch · 15 files changed

+152/−84 lines, 15 files

Files

Control/Exception/Base.hs view
@@ -340,8 +340,8 @@ -- -- Note that we have to give a type signature to @e@, or the program -- will not typecheck as the type is ambiguous. While it is possible--- to catch exceptions of any type, see $catchall for an explanation--- of the problems with doing so.+-- to catch exceptions of any type, see the previous section \"Catching all+-- exceptions\" for an explanation of the problems with doing so. -- -- For catching exceptions in pure (non-'IO') expressions, see the -- function 'evaluate'.
Data/Data.hs view
@@ -480,8 +480,9 @@                deriving Show ---- | Representation of constructors+-- | Representation of constructors. Note that equality on constructors+-- with different types may not work -- i.e. the constructors for 'False' and+-- 'Nothing' may compare equal. data Constr = Constr                         { conrep    :: ConstrRep                         , constring :: String
Data/Typeable.hs view
@@ -302,6 +302,22 @@ -- ------------------------------------------------------------- +{- Note [Memoising typeOf]+~~~~~~~~~~~~~~~~~~~~~~~~~~+IMPORTANT: we don't want to recalculate the type-rep once per+call to the dummy argument.  This is what went wrong in Trac #3245+So we help GHC by manually keeping the 'rep' *outside* the value +lambda, thus+    +    typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep+    typeOfDefault = \_ -> rep+      where+        rep = typeOf1 (undefined :: t a) `mkAppTy` +              typeOf  (undefined :: a)++Notice the crucial use of scoped type variables here!+-}+ -- | The class 'Typeable' allows a concrete representation of a type to -- be calculated. class Typeable a where@@ -316,77 +332,84 @@   typeOf1 :: t a -> TypeRep  -- | For defining a 'Typeable' instance from any 'Typeable1' instance.-typeOfDefault :: (Typeable1 t, Typeable a) => t a -> TypeRep-typeOfDefault x = typeOf1 x `mkAppTy` typeOf (argType x)+typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep+typeOfDefault = \_ -> rep  where-   argType :: t a -> a-   argType =  undefined+   rep = typeOf1 (undefined :: t a) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]  -- | Variant for binary type constructors class Typeable2 t where   typeOf2 :: t a b -> TypeRep  -- | For defining a 'Typeable1' instance from any 'Typeable2' instance.-typeOf1Default :: (Typeable2 t, Typeable a) => t a b -> TypeRep-typeOf1Default x = typeOf2 x `mkAppTy` typeOf (argType x)+typeOf1Default :: forall t a b. (Typeable2 t, Typeable a) => t a b -> TypeRep+typeOf1Default = \_ -> rep   where-   argType :: t a b -> a-   argType =  undefined+   rep = typeOf2 (undefined :: t a b) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]  -- | Variant for 3-ary type constructors class Typeable3 t where   typeOf3 :: t a b c -> TypeRep  -- | For defining a 'Typeable2' instance from any 'Typeable3' instance.-typeOf2Default :: (Typeable3 t, Typeable a) => t a b c -> TypeRep-typeOf2Default x = typeOf3 x `mkAppTy` typeOf (argType x)+typeOf2Default :: forall t a b c. (Typeable3 t, Typeable a) => t a b c -> TypeRep+typeOf2Default = \_ -> rep   where-   argType :: t a b c -> a-   argType =  undefined+   rep = typeOf3 (undefined :: t a b c) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]  -- | Variant for 4-ary type constructors class Typeable4 t where   typeOf4 :: t a b c d -> TypeRep  -- | For defining a 'Typeable3' instance from any 'Typeable4' instance.-typeOf3Default :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep-typeOf3Default x = typeOf4 x `mkAppTy` typeOf (argType x)+typeOf3Default :: forall t a b c d. (Typeable4 t, Typeable a) => t a b c d -> TypeRep+typeOf3Default = \_ -> rep  where-   argType :: t a b c d -> a-   argType =  undefined-+   rep = typeOf4 (undefined :: t a b c d) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+    -- | Variant for 5-ary type constructors class Typeable5 t where   typeOf5 :: t a b c d e -> TypeRep  -- | For defining a 'Typeable4' instance from any 'Typeable5' instance.-typeOf4Default :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep-typeOf4Default x = typeOf5 x `mkAppTy` typeOf (argType x)+typeOf4Default :: forall t a b c d e. (Typeable5 t, Typeable a) => t a b c d e -> TypeRep+typeOf4Default = \_ -> rep   where-   argType :: t a b c d e -> a-   argType =  undefined+   rep = typeOf5 (undefined :: t a b c d e) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]  -- | Variant for 6-ary type constructors class Typeable6 t where   typeOf6 :: t a b c d e f -> TypeRep  -- | For defining a 'Typeable5' instance from any 'Typeable6' instance.-typeOf5Default :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep-typeOf5Default x = typeOf6 x `mkAppTy` typeOf (argType x)+typeOf5Default :: forall t a b c d e f. (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep+typeOf5Default = \_ -> rep  where-   argType :: t a b c d e f -> a-   argType =  undefined+   rep = typeOf6 (undefined :: t a b c d e f) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]  -- | Variant for 7-ary type constructors class Typeable7 t where   typeOf7 :: t a b c d e f g -> TypeRep  -- | For defining a 'Typeable6' instance from any 'Typeable7' instance.-typeOf6Default :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep-typeOf6Default x = typeOf7 x `mkAppTy` typeOf (argType x)+typeOf6Default :: forall t a b c d e f g. (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep+typeOf6Default = \_ -> rep  where-   argType :: t a b c d e f g -> a-   argType =  undefined+   rep = typeOf7 (undefined :: t a b c d e f g) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]  #ifdef __GLASGOW_HASKELL__ -- Given a @Typeable@/n/ instance for an /n/-ary type constructor,
Data/Unique.hs view
@@ -21,20 +21,20 @@  import Prelude -import Control.Concurrent.MVar import System.IO.Unsafe (unsafePerformIO)  #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Num+import GHC.Conc #endif  -- | An abstract unique object.  Objects of type 'Unique' may be -- compared for equality and ordering and hashed into 'Int'. newtype Unique = Unique Integer deriving (Eq,Ord) -uniqSource :: MVar Integer-uniqSource = unsafePerformIO (newMVar 0)+uniqSource :: TVar Integer+uniqSource = unsafePerformIO (newTVarIO 0) {-# NOINLINE uniqSource #-}  -- | Creates a new object of type 'Unique'.  The value returned will@@ -42,11 +42,18 @@ -- previous calls to 'newUnique'.  There is no limit on the number of -- times 'newUnique' may be called. newUnique :: IO Unique-newUnique = do-   val <- takeMVar uniqSource-   let next = val+1-   putMVar uniqSource next-   return (Unique next)+newUnique = atomically $ do+  val <- readTVar uniqSource+  let next = val+1+  writeTVar uniqSource $! next+  return (Unique next)++-- SDM (18/3/2010): changed from MVar to STM.  This fixes+--  1. there was no async exception protection+--  2. there was a space leak (now new value is strict)+--  3. using atomicModifyIORef would be slightly quicker, but can+--     suffer from adverse scheduling issues (see #3838)+--  4. also, the STM version is faster.  -- | Hashes a 'Unique' into an 'Int'.  Two 'Unique's may hash to the -- same value, although in practice this is unlikely.  The 'Int'
GHC/Conc.lhs view
@@ -215,7 +215,7 @@ (see 'Control.Exception.block').  The newly created thread has an exception handler that discards the-exceptions 'BlockedOnDeadMVar', 'BlockedIndefinitely', and+exceptions 'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM', and 'ThreadKilled', and passes all other exceptions to the uncaught exception handler (see 'setUncaughtExceptionHandler'). -}@@ -837,10 +837,11 @@  prodServiceThread :: IO () prodServiceThread = do-  was_set <- readIORef prodding-  writeIORef prodding True-     -- no need for atomicModifyIORef, extra prods are harmless.-  if (not (was_set)) then wakeupIOManager else return ()+  -- NB. use atomicModifyIORef here, otherwise there are race+  -- conditions in which prodding is left at True but the server is+  -- blocked in select().+  was_set <- atomicModifyIORef prodding $ \b -> (True,b)+  if (not (was_set)) then  wakeupIOManager else return ()  -- Machinery needed to ensure that we only have one copy of certain -- CAFs in this module even when the base package is present twice, as@@ -1014,6 +1015,17 @@    -> IO () service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do +  -- reset prodding before we look at the new requests.  If a new+  -- client arrives after this point they will send a wakup which will+  -- cause the server to loop around again, so we can be sure to not+  -- miss any requests.+  --+  -- NB. it's important to do this in the *first* iteration of+  -- service_loop, rather than after calling select(), since a client+  -- may have set prodding to True without sending a wakeup byte down+  -- the pipe, because the pipe wasn't set up.+  atomicModifyIORef prodding (\_ -> (False, ()))+   -- pick up new IO requests   new_reqs <- atomicModifyIORef pendingEvents (\a -> ([],a))   let reqs = new_reqs ++ old_reqs@@ -1083,8 +1095,6 @@                        return False    unless exit $ do--  atomicModifyIORef prodding (\_ -> (False, ()))    reqs' <- if wakeup_all then do wakeupAll reqs; return []                          else completeRequests reqs readfds writefds []
GHC/ForeignPtr.hs view
@@ -42,11 +42,11 @@ import GHC.Show import GHC.List         ( null ) import GHC.Base--- import GHC.IO import GHC.IORef import GHC.STRef        ( STRef(..) ) import GHC.Ptr          ( Ptr(..), FunPtr(..) ) import GHC.Err+import GHC.Num          ( fromInteger )  #include "Typeable.h" @@ -150,7 +150,9 @@ --  mallocForeignPtr = doMalloc undefined   where doMalloc :: Storable b => b -> IO (ForeignPtr b)-        doMalloc a = do+        doMalloc a+          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"+          | otherwise = do           r <- newIORef (NoFinalizers, [])           IO $ \s ->             case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->@@ -163,6 +165,8 @@ -- | This function is similar to 'mallocForeignPtr', except that the -- size of the memory required is given explicitly as a number of bytes. mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)+mallocForeignPtrBytes size | size < 0 =+  error "mallocForeignPtrBytes: size must be >= 0" mallocForeignPtrBytes (I# size) = do    r <- newIORef (NoFinalizers, [])   IO $ \s ->@@ -187,7 +191,9 @@ mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a) mallocPlainForeignPtr = doMalloc undefined   where doMalloc :: Storable b => b -> IO (ForeignPtr b)-        doMalloc a = IO $ \s ->+        doMalloc a+          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"+          | otherwise = IO $ \s ->             case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->              (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))                                (PlainPtr mbarr#) #)@@ -200,6 +206,8 @@ -- finalizer is used. Attempts to add a finalizer will cause an -- exception to be thrown. mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a)+mallocPlainForeignPtrBytes size | size < 0 =+  error "mallocPlainForeignPtrBytes: size must be >= 0" mallocPlainForeignPtrBytes (I# size) = IO $ \s ->     case newPinnedByteArray# size s      of { (# s', mbarr# #) ->        (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
GHC/Handle.hs view
@@ -15,7 +15,7 @@  -- #hide -module GHC.Handle {-# DEPRECATED "use GHC.IO.Handle.Base instead" #-} (+module GHC.Handle {-# DEPRECATED "use GHC.IO.Handle instead" #-} (   withHandle, withHandle', withHandle_,   wantWritableHandle, wantReadableHandle, wantSeekableHandle,
GHC/IO/Exception.hs view
@@ -64,7 +64,7 @@  ----- --- |The thread is awiting to retry an STM transaction, but there are no+-- |The thread is waiting to retry an STM transaction, but there are no -- other references to any @TVar@s involved, so it can't ever continue. data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM     deriving Typeable@@ -91,8 +91,7 @@  ----- --- |There are no runnable threads, so the program is deadlocked.--- The @Deadlock@ exception is raised in the main thread only.+-- |'assert' was applied to 'False'. data AssertionFailed = AssertionFailed String     deriving Typeable
GHC/IO/Handle.hs view
@@ -51,7 +51,7 @@ import GHC.IO.Handle.Types import GHC.IO.Handle.Internals import GHC.IO.Handle.Text-import System.IO.Error+import qualified GHC.IO.BufferedIO as Buffered  import GHC.Base import GHC.Exception@@ -140,14 +140,24 @@ -- physical file, if the current I\/O position is equal to the length of -- the file.  Otherwise, it returns 'False'. ----- NOTE: 'hIsEOF' may block, because it is the same as calling--- 'hLookAhead' and checking for an EOF exception.+-- NOTE: 'hIsEOF' may block, because it has to attempt to read from+-- the stream to determine whether there is any more data to be read.  hIsEOF :: Handle -> IO Bool-hIsEOF handle =-  catch-     (hLookAhead handle >> return False)-     (\e -> if isEOFError e then return True else ioError e)+hIsEOF handle = wantReadableHandle_ "hIsEOF" handle $ \Handle__{..} -> do++  cbuf <- readIORef haCharBuffer+  if not (isEmptyBuffer cbuf) then return False else do++  bbuf <- readIORef haByteBuffer+  if not (isEmptyBuffer bbuf) then return False else do++  -- NB. do no decoding, just fill the byte buffer; see #3808+  (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf+  if r == 0+     then return True+     else do writeIORef haByteBuffer bbuf'+             return False  -- --------------------------------------------------------------------------- -- Looking ahead
GHC/List.lhs view
@@ -108,7 +108,7 @@ null []                 =  True null (_:_)              =  False --- | 'length' returns the length of a finite list as an 'Int'.+-- | /O(n)/. 'length' returns the length of a finite list as an 'Int'. -- It is an instance of the more general 'Data.List.genericLength', -- the result type of which may be any kind of number. length                  :: [a] -> Int
System/CPUTime.hsc view
@@ -108,7 +108,7 @@ #else # if defined(HAVE_TIMES)     allocaBytes (#const sizeof(struct tms)) $ \ p_tms -> do-    times p_tms+    _ <- times p_tms     u_ticks  <- (#peek struct tms,tms_utime) p_tms :: IO CClock     s_ticks  <- (#peek struct tms,tms_stime) p_tms :: IO CClock     return (( (realToInteger u_ticks + realToInteger s_ticks) * 1000000000000)
System/Exit.hs view
@@ -42,7 +42,7 @@ -- --------------------------------------------------------------------------- -- exitWith --- | Computation 'exitWith' @code@ throws 'ExitException' @code@.+-- | Computation 'exitWith' @code@ throws 'ExitCode' @code@. -- Normally this terminates the program, returning @code@ to the -- program's caller.  Before the program terminates, any open or -- semi-closed handles are first closed.@@ -52,9 +52,9 @@ -- A program that terminates successfully without calling 'exitWith' -- explicitly is treated as it it had called 'exitWith' 'ExitSuccess'. ----- As an 'ExitException' is not an 'IOError', 'exitWith' bypasses+-- As an 'ExitCode' is not an 'IOError', 'exitWith' bypasses -- the error handling in the 'IO' monad and cannot be intercepted by--- 'catch' from the "Prelude".  However it is an 'Exception', and can+-- 'catch' from the "Prelude".  However it is a 'SomeException', and can -- be caught using the functions of "Control.Exception".  This means -- that cleanup computations added with 'Control.Exception.bracket' -- (from "Control.Exception") are also executed properly on 'exitWith'.
System/IO.hs view
@@ -234,9 +234,11 @@  #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.IORef import GHC.IO.Exception ( userError )@@ -543,10 +545,10 @@     oflags = oflags1 .|. binary_flags #endif -#ifdef __NHC__+#if defined(__NHC__)     findTempName x = do h <- openFile filepath ReadWriteMode                         return (filepath, h)-#else+#elif defined(__GLASGOW_HASKELL__)     findTempName x = do       fd <- withFilePath filepath $ \ f ->               c_open f oflags mode@@ -557,12 +559,20 @@            then findTempName (x+1)            else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))        else do-         -- XXX We want to tell fdToHandle what the filepath is,-         -- as any exceptions etc will only be able to report the-         -- fd currently++         (fD,fd_type) <- FD.mkFD (fromIntegral fd) ReadWriteMode Nothing{-no stat-}+                              False{-is_socket-} +                              True{-is_nonblock-}++         h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-}+                           (Just localeEncoding)++         return (filepath, h)+#else          h <- fdToHandle fd `onException` c_close fd          return (filepath, h) #endif+       where         filename        = prefix ++ show x ++ suffix         filepath        = tmp_dir `combine` filename
base.cabal view
@@ -1,5 +1,5 @@ name:           base-version:        4.2.0.0+version:        4.2.0.1 license:        BSD3 license-file:   LICENSE maintainer:     libraries@haskell.org
include/HsBaseConfig.h view
@@ -425,7 +425,7 @@ #define HTYPE_CHAR Int8  /* Define to Haskell type for clock_t */-#define HTYPE_CLOCK_T Int64+#define HTYPE_CLOCK_T Int32  /* Define to Haskell type for dev_t */ #define HTYPE_DEV_T Word64@@ -449,10 +449,10 @@ #define HTYPE_INTMAX_T Int64  /* Define to Haskell type for intptr_t */-#define HTYPE_INTPTR_T Int64+#define HTYPE_INTPTR_T Int32  /* Define to Haskell type for long */-#define HTYPE_LONG Int64+#define HTYPE_LONG Int32  /* Define to Haskell type for long long */ #define HTYPE_LONG_LONG Int64@@ -461,7 +461,7 @@ #define HTYPE_MODE_T Word32  /* Define to Haskell type for nlink_t */-#define HTYPE_NLINK_T Word64+#define HTYPE_NLINK_T Word32  /* Define to Haskell type for off_t */ #define HTYPE_OFF_T Int64@@ -470,7 +470,7 @@ #define HTYPE_PID_T Int32  /* Define to Haskell type for ptrdiff_t */-#define HTYPE_PTRDIFF_T Int64+#define HTYPE_PTRDIFF_T Int32  /* Define to Haskell type for rlim_t */ #define HTYPE_RLIM_T Word64@@ -485,19 +485,19 @@ #define HTYPE_SIG_ATOMIC_T Int32  /* Define to Haskell type for size_t */-#define HTYPE_SIZE_T Word64+#define HTYPE_SIZE_T Word32  /* Define to Haskell type for speed_t */ #define HTYPE_SPEED_T Word32  /* Define to Haskell type for ssize_t */-#define HTYPE_SSIZE_T Int64+#define HTYPE_SSIZE_T Int32  /* Define to Haskell type for tcflag_t */ #define HTYPE_TCFLAG_T Word32  /* Define to Haskell type for time_t */-#define HTYPE_TIME_T Int64+#define HTYPE_TIME_T Int32  /* Define to Haskell type for uid_t */ #define HTYPE_UID_T Word32@@ -506,7 +506,7 @@ #define HTYPE_UINTMAX_T Word64  /* Define to Haskell type for uintptr_t */-#define HTYPE_UINTPTR_T Word64+#define HTYPE_UINTPTR_T Word32  /* Define to Haskell type for unsigned char */ #define HTYPE_UNSIGNED_CHAR Word8@@ -515,7 +515,7 @@ #define HTYPE_UNSIGNED_INT Word32  /* Define to Haskell type for unsigned long */-#define HTYPE_UNSIGNED_LONG Word64+#define HTYPE_UNSIGNED_LONG Word32  /* Define to Haskell type for unsigned long long */ #define HTYPE_UNSIGNED_LONG_LONG Word64@@ -548,7 +548,7 @@ #define STDC_HEADERS 1  /* Number of bits in a file offset, on hosts where this is settable. */-/* #undef _FILE_OFFSET_BITS */+#define _FILE_OFFSET_BITS 64  /* Define for large files, on AIX-style hosts. */ /* #undef _LARGE_FILES */