base 4.6.0.0 → 4.6.0.1

raw patch · 17 files changed

+177/−145 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Arrow.hs +1/−1
• Control/Exception/Base.hs +0/−16
• Data/List.hs +1/−1
• GHC/Conc/Sync.lhs +7/−5
• GHC/Event/Clock.hsc +7/−98
• GHC/Event/KQueue.hsc +15/−1
• GHC/Event/Thread.hs +0/−2
• GHC/Generics.hs +2/−1
• GHC/Int.hs +16/−8
• GHC/Weak.lhs +20/−2
• System/Mem/Weak.hs +4/−9
• base.cabal +1/−1
• configure +72/−0
• configure.ac +6/−0
• include/EventConfig.h +6/−0
• include/HsBase.h +13/−0
• include/HsBaseConfig.h +6/−0

@@ -192,7 +192,7 @@ -- --  * @'left' (f >>> g) = 'left' f >>> 'left' g@ -----  * @'left' f >>> 'arr' 'Left' = 'arr' 'Left' >>> f@+--  * @f >>> 'arr' 'Left' = 'arr' 'Left' >>> 'left' f@ -- --  * @'left' f >>> 'arr' ('id' +++ g) = 'arr' ('id' +++ g) >>> 'left' f@ --

@@ -379,22 +379,6 @@ -- might get a the opposite behaviour. This is ok, because 'catch' is an -- 'IO' computation. ----- Note that the "Prelude" also exports a function called--- 'Prelude.catch' with a similar type to 'Control.Exception.catch',--- except that the "Prelude" version only catches the IO and user--- families of exceptions (as required by Haskell 98).------ We recommend either hiding the "Prelude" version of 'Prelude.catch'--- when importing "Control.Exception":------ > import Prelude hiding (catch)------ or importing "Control.Exception" qualified, to avoid name-clashes:------ > import qualified Control.Exception as C------ and then using @C.catch@--- #ifndef __NHC__ catch   :: Exception e         => IO a         -- ^ The computation to run

@@ -509,7 +509,7 @@                                  (s', ys) = mapAccumR f s xs  -- | The 'insert' function takes an element and a list and inserts the--- element into the list at the last position where it is still less+-- element into the list at the first position where it is less -- than or equal to the next element.  In particular, if the list -- is sorted before the call, the result will also be sorted. -- It is a special case of 'insertBy', which allows the programmer to

@@ -113,12 +113,14 @@ import {-# SOURCE #-} GHC.IO.Handle ( hFlush ) import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout ) import GHC.IO+import GHC.IO.Encoding.UTF8 import GHC.IO.Exception import GHC.Exception+import qualified GHC.Foreign import GHC.IORef import GHC.MVar+import GHC.Ptr import GHC.Real         ( fromIntegral )-import GHC.Pack         ( packCString# ) import GHC.Show         ( Show(..), showString ) import GHC.Weak @@ -427,10 +429,10 @@ -}  labelThread :: ThreadId -> String -> IO ()-labelThread (ThreadId t) str = IO $ \ s ->-   let !ps  = packCString# str-       !adr = byteArrayContents# ps in-     case (labelThread# t adr s) of s1 -> (# s1, () #)+labelThread (ThreadId t) str =+    GHC.Foreign.withCString utf8 str $ \(Ptr p) ->+    IO $ \ s ->+     case labelThread# t p s of s1 -> (# s1, () #)  --      Nota Bene: 'pseq' used to be 'seq' --                 but 'seq' is now defined in PrelGHC

@@ -1,108 +1,17 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE NoImplicitPrelude, BangPatterns, ForeignFunctionInterface, CApiFFI #-}--module GHC.Event.Clock (getMonotonicTime, initializeTimer) where+{-# LANGUAGE NoImplicitPrelude, ForeignFunctionInterface #-} -#include "HsBase.h"+module GHC.Event.Clock (getMonotonicTime) where -import Foreign-import Foreign.C.Types import GHC.Base import GHC.Real--#if !darwin_HOST_OS-import Foreign.C.Error (throwErrnoIfMinus1_)-import GHC.Err-import GHC.Num-#endif---- TODO: Implement this for Windows.--initializeTimer :: IO ()+import Data.Word  -- | Return monotonic time in seconds, since some unspecified starting point getMonotonicTime :: IO Double----------------------------------------------------------------------------- FFI binding--#if HAVE_CLOCK_GETTIME--initializeTimer = return ()--getMonotonicTime = do-    tv <- with (CTimespec 0 0) $ \tvptr -> do-        throwErrnoIfMinus1_ "clock_gettime" (clock_gettime (#const CLOCK_ID) tvptr)-        peek tvptr-    let !t = realToFrac (sec tv) + realToFrac (nsec tv) / 1000000000.0-    return t--data CTimespec = CTimespec-    { sec  :: {-# UNPACK #-} !CTime-    , nsec :: {-# UNPACK #-} !CLong-    }--instance Storable CTimespec where-    sizeOf _ = #size struct timespec-    alignment _ = alignment (undefined :: CLong)--    peek ptr = do-        sec' <- #{peek struct timespec, tv_sec} ptr-        nsec' <- #{peek struct timespec, tv_nsec} ptr-        return $ CTimespec sec' nsec'--    poke ptr tv = do-        #{poke struct timespec, tv_sec} ptr (sec tv)-        #{poke struct timespec, tv_nsec} ptr (nsec tv)--foreign import capi unsafe "HsBase.h clock_gettime" clock_gettime-    :: Int -> Ptr CTimespec -> IO CInt--#elif darwin_HOST_OS--getMonotonicTime = do-    with 0.0 $ \timeptr -> do-    absolute_time timeptr-    ctime <- peek timeptr-    let !time = realToFrac ctime-    return time--foreign import capi unsafe "HsBase.h absolute_time" absolute_time ::-    Ptr CDouble -> IO ()--foreign import capi unsafe "HsBase.h initialize_timer"-  initializeTimer :: IO ()--#else--initializeTimer = return ()--getMonotonicTime = do-    tv <- with (CTimeval 0 0) $ \tvptr -> do-        throwErrnoIfMinus1_ "gettimeofday" (gettimeofday tvptr nullPtr)-        peek tvptr-    let !t = realToFrac (sec tv) + realToFrac (usec tv) / 1000000.0-    return t--data CTimeval = CTimeval-    { sec  :: {-# UNPACK #-} !CTime-    , usec :: {-# UNPACK #-} !CSUSeconds-    }--instance Storable CTimeval where-    sizeOf _ = #size struct timeval-    alignment _ = alignment (undefined :: CLong)--    peek ptr = do-        sec' <- #{peek struct timeval, tv_sec} ptr-        usec' <- #{peek struct timeval, tv_usec} ptr-        return $ CTimeval sec' usec'--    poke ptr tv = do-        #{poke struct timeval, tv_sec} ptr (sec tv)-        #{poke struct timeval, tv_usec} ptr (usec tv)+getMonotonicTime = do w <- getMonotonicNSec+                      return (fromIntegral w / 1000000000) -foreign import capi unsafe "HsBase.h gettimeofday" gettimeofday-    :: Ptr CTimeval -> Ptr () -> IO CInt+foreign import ccall unsafe "getMonotonicNSec"+    getMonotonicNSec :: IO Word64 -#endif

@@ -50,6 +50,8 @@ #if defined(HAVE_KEVENT64) import Data.Int (Int64) import Data.Word (Word64)+#elif defined(netbsd_HOST_OS)+import Data.Int (Int64) #endif  #include <sys/types.h>@@ -172,7 +174,11 @@     , filter :: {-# UNPACK #-} !Filter     , flags  :: {-# UNPACK #-} !Flag     , fflags :: {-# UNPACK #-} !FFlag+#ifdef netbsd_HOST_OS+    , data_  :: {-# UNPACK #-} !Int64+#else     , data_  :: {-# UNPACK #-} !CIntPtr+#endif     , udata  :: {-# UNPACK #-} !(Ptr ())     } deriving Show @@ -210,7 +216,11 @@  , noteEOF = NOTE_EOF  } +#if SIZEOF_KEV_FLAGS == 4 /* kevent.flag: uint32_t or uint16_t. */+newtype Flag = Flag Word32+#else newtype Flag = Flag Word16+#endif     deriving (Eq, Show, Storable)  #{enum Flag, Flag@@ -218,7 +228,11 @@  , flagDelete  = EV_DELETE  } +#if SIZEOF_KEV_FILTER == 4 /*kevent.filter: uint32_t or uint16_t. */+newtype Filter = Filter Word32+#else newtype Filter = Filter Word16+#endif     deriving (Bits, Eq, Num, Show, Storable)  #{enum Filter, Filter@@ -291,7 +305,7 @@     c_kevent64 :: QueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt -> CUInt                -> Ptr TimeSpec -> IO CInt #elif defined(HAVE_KEVENT)-foreign import ccall safe "kevent"+foreign import ccall safe "__hscore_kevent"     c_kevent :: QueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt              -> Ptr TimeSpec -> IO CInt #else

@@ -25,7 +25,6 @@ import GHC.Event.Internal (eventIs, evtClose) import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,                              new, registerFd, unregisterFd_, registerTimeout)-import GHC.Event.Clock (initializeTimer) import qualified GHC.Event.Manager as M import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (Fd)@@ -124,7 +123,6 @@ ensureIOManagerIsRunning   | not threaded = return ()   | otherwise = do-      initializeTimer       startIOManagerThread  startIOManagerThread :: IO ()

@@ -163,7 +163,8 @@   to    :: (Rep a) x -> a  --- | Representable types of kind * -> * (not yet derivable)+-- | Representable types of kind * -> *.+-- This class is derivable in GHC with the DeriveGeneric flag on. class Generic1 f where   -- | Generic representation type   type Rep1 f :: * -> *

@@ -620,18 +620,26 @@   divInt64#, modInt64# :: Int64# -> Int64# -> Int64#++-- Define div in terms of quot, being careful to avoid overflow (#7233) x# `divInt64#` y#-    | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#)-        = ((x# `minusInt64#` y#) `minusInt64#` intToInt64# 1#) `quotInt64#` y#-    | (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#)-        = ((x# `minusInt64#` y#) `plusInt64#` intToInt64# 1#) `quotInt64#` y#-    | otherwise                = x# `quotInt64#` y#+    | (x# `gtInt64#` zero) && (y# `ltInt64#` zero)+        = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one+    | (x# `ltInt64#` zero) && (y# `gtInt64#` zero)+        = ((x# `plusInt64#` one)  `quotInt64#` y#) `minusInt64#` one+    | otherwise+        = x# `quotInt64#` y#+    where+    !zero = intToInt64# 0#+    !one  = intToInt64# 1#+ x# `modInt64#` y#-    | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#) ||-      (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#)-        = if r# `neInt64#` intToInt64# 0# then r# `plusInt64#` y# else intToInt64# 0#+    | (x# `gtInt64#` zero) && (y# `ltInt64#` zero) ||+      (x# `ltInt64#` zero) && (y# `gtInt64#` zero)+        = if r# `neInt64#` zero then r# `plusInt64#` y# else zero     | otherwise = r#     where+    !zero = intToInt64# 0#     !r# = x# `remInt64#` y#  instance Read Int64 where

@@ -55,7 +55,7 @@ attempt is made to run outstanding finalizers when the program exits. Therefore finalizers should not be relied on to clean up resources - other methods (eg. exception handlers) should be employed, possibly in-addition to finalisers.+addition to finalizers.  References from the finalizer to the key are treated in the same way as references from the value to the key: they do not keep the key@@ -76,6 +76,24 @@  If there are no other threads to run, the runtime system will check for runnable finalizers before declaring the system to be deadlocked.++WARNING: weak pointers to ordinary non-primitive Haskell types are+particularly fragile, because the compiler is free to optimise away or+duplicate the underlying data structure.  Therefore attempting to+place a finalizer on an ordinary Haskell type may well result in the+finalizer running earlier than you expected.  This is not a problem+for caches and memo tables where early finalization is benign.++Finalizers /can/ be used reliably for types that are created explicitly+and have identity, such as @IORef@ and @MVar@.  However, to place a+finalizer on one of these types, you should use the specific operation+provided for that type, e.g. @mkWeakIORef@ and @addMVarFinalizer@+respectively (the non-uniformity is accidental).  These operations+attach the finalizer to the primitive object inside the box+(e.g. @MutVar#@ in the case of @IORef@), because attaching the+finalizer to the box itself fails when the outer box is optimised away+by the compiler.+ -} data Weak v = Weak (Weak# v) @@ -116,7 +134,7 @@ finalize :: Weak v -> IO () finalize (Weak w) = IO $ \s ->    case finalizeWeak# w s of-        (# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finaliser+        (# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finalizer         (# s1, _,  f #) -> f s1  {-

@@ -94,15 +94,10 @@   when the key becomes unreachable).    Note: adding a finalizer to a 'Foreign.ForeignPtr.ForeignPtr' using-  'addFinalizer' won't work as well as using the specialised version-  'Foreign.ForeignPtr.addForeignPtrFinalizer' because the latter-  version adds the finalizer to the primitive 'ForeignPtr#' object-  inside, whereas the generic 'addFinalizer' will add the finalizer to-  the box.  Optimisations tend to remove the box, which may cause the-  finalizer to run earlier than you intended.  The same motivation-  justifies the existence of-  'Control.Concurrent.MVar.addMVarFinalizer' and-  'Data.IORef.mkWeakIORef' (the non-uniformity is accidental).+  'addFinalizer' won't work; use the specialised version+  'Foreign.ForeignPtr.addForeignPtrFinalizer' instead.  For discussion+  see the 'Weak' type.+. -} addFinalizer :: key -> IO () -> IO () addFinalizer key finalizer = do

@@ -1,5 +1,5 @@ name:           base-version:        4.6.0.0+version:        4.6.0.1 license:        BSD3 license-file:   LICENSE maintainer:     libraries@haskell.org

@@ -3999,6 +3999,78 @@  $as_echo "#define HAVE_KQUEUE 1" >>confdefs.h ++  # The cast to long int works around a bug in the HP C Compiler+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.+# This bug is HP SR number 8606223364.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of kev.filter" >&5+$as_echo_n "checking size of kev.filter... " >&6; }+if test "${ac_cv_sizeof_kev_filter+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (kev.filter))" "ac_cv_sizeof_kev_filter"        "#include <sys/event.h>+struct kevent kev;+"; then :++else+  if test "$ac_cv_type_kev_filter" = yes; then+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error 77 "cannot compute sizeof (kev.filter)+See \`config.log' for more details" "$LINENO" 5 ; }+   else+     ac_cv_sizeof_kev_filter=0+   fi+fi++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_kev_filter" >&5+$as_echo "$ac_cv_sizeof_kev_filter" >&6; }++++cat >>confdefs.h <<_ACEOF+#define SIZEOF_KEV_FILTER $ac_cv_sizeof_kev_filter+_ACEOF++++  # The cast to long int works around a bug in the HP C Compiler+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.+# This bug is HP SR number 8606223364.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of kev.flags" >&5+$as_echo_n "checking size of kev.flags... " >&6; }+if test "${ac_cv_sizeof_kev_flags+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (kev.flags))" "ac_cv_sizeof_kev_flags"        "#include <sys/event.h>+struct kevent kev;+"; then :++else+  if test "$ac_cv_type_kev_flags" = yes; then+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error 77 "cannot compute sizeof (kev.flags)+See \`config.log' for more details" "$LINENO" 5 ; }+   else+     ac_cv_sizeof_kev_flags=0+   fi+fi++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_kev_flags" >&5+$as_echo "$ac_cv_sizeof_kev_flags" >&6; }++++cat >>confdefs.h <<_ACEOF+#define SIZEOF_KEV_FLAGS $ac_cv_sizeof_kev_flags+_ACEOF++ fi  if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then

@@ -51,6 +51,12 @@  if test "$ac_cv_header_sys_event_h" = yes -a "$ac_cv_func_kqueue" = yes; then   AC_DEFINE([HAVE_KQUEUE], [1], [Define if you have kqueue support.])++  AC_CHECK_SIZEOF([kev.filter], [], [#include <sys/event.h>+struct kevent kev;])++  AC_CHECK_SIZEOF([kev.flags], [], [#include <sys/event.h>+struct kevent kev;]) fi  if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then

@@ -84,3 +84,9 @@  /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1++/* The size of `kev.filter', as computed by sizeof. */+/* #undef SIZEOF_KEV_FILTER */++/* The size of `kev.flags', as computed by sizeof. */+/* #undef SIZEOF_KEV_FLAGS */

@@ -155,6 +155,10 @@ #include <sys/select.h> #endif +#if HAVE_SYS_EVENT_H+#include <sys/event.h>+#endif+ /* in inputReady.c */ extern int fdReady(int fd, int write, int msecs, int isSock); @@ -540,6 +544,15 @@ 	return open(file,how,mode); } #endif++#ifdef HAVE_KEVENT+INLINE int __hscore_kevent(int kq, const struct kevent *changelist,+                           size_t nchanges, struct kevent *eventlist,+                           size_t nevents, const struct timespec *timeout) {+	return kevent(kq, changelist, nchanges, eventlist, nevents, timeout);+}+#endif+  #if darwin_HOST_OS // You should not access _environ directly on Darwin in a bundle/shared library.

@@ -592,6 +592,12 @@ /* Define to the version of this package. */ #define PACKAGE_VERSION "1.0" +/* The size of `kev.filter', as computed by sizeof. */+/* #undef SIZEOF_KEV_FILTER */++/* The size of `kev.flags', as computed by sizeof. */+/* #undef SIZEOF_KEV_FLAGS */+ /* The size of `struct MD5Context', as computed by sizeof. */ #define SIZEOF_STRUCT_MD5CONTEXT 88