base 4.8.0.0 → 4.8.1.0

raw patch · 15 files changed

+312/−41 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Traversable.hs +3/−4
• GHC/Event.hs +1/−0
• GHC/Event/Internal.hs +7/−2
• GHC/Event/Manager.hs +28/−12
• GHC/IO/Encoding.hs +27/−2
• GHC/IO/Encoding/Iconv.hs +20/−7
• GHC/IO/Encoding/Latin1.hs +79/−4
• GHC/IO/Exception.hs +1/−1
• GHC/List.hs +9/−2
• GHC/SrcLoc.hs +33/−0
• GHC/Stack.hsc +56/−1
• GHC/TopHandler.hs +33/−1
• System/IO.hs +4/−4
• base.cabal +2/−1
• changelog.md +9/−0

@@ -144,10 +144,9 @@ class (Functor t, Foldable t) => Traversable t where     {-# MINIMAL traverse | sequenceA #-} -    -- | Map each element of a structure to an action, evaluate these-    -- these actions from left to right, and collect the results.-    -- actions from left to right, and collect the results. For a-    -- version that ignores the results see 'Data.Foldable.traverse_'.+    -- | Map each element of a structure to an action, evaluate these actions+    -- from left to right, and collect the results. For a version that ignores+    -- the results see 'Data.Foldable.traverse_'.     traverse :: Applicative f => (a -> f b) -> t a -> f (t b)     traverse f = sequenceA . fmap f 

@@ -25,6 +25,7 @@     , evtWrite     , IOCallback     , FdKey(keyFd)+    , Lifetime(..)     , registerFd     , unregisterFd     , unregisterFd_

@@ -83,8 +83,12 @@ evtConcat = foldl' evtCombine evtNothing {-# INLINE evtConcat #-} --- | The lifetime of a registration.-data Lifetime = OneShot | MultiShot+-- | The lifetime of an event registration.+--+-- @since 4.8.1.0+data Lifetime = OneShot   -- ^ the registration will be active for only one+                          -- event+              | MultiShot -- ^ the registration will trigger multiple times               deriving (Show, Eq)  -- | The longer of two lifetimes.@@ -93,6 +97,7 @@ elSupremum _       _       = MultiShot {-# INLINE elSupremum #-} +-- | @mappend@ == @elSupremum@ instance Monoid Lifetime where     mempty = OneShot     mappend = elSupremum

@@ -456,20 +456,35 @@    | otherwise = do     fdds <- withMVar (callbackTableVar mgr fd) $ \tbl ->-        IT.delete (fromIntegral fd) tbl >>= maybe (return []) selectCallbacks+        IT.delete (fromIntegral fd) tbl >>= maybe (return []) (selectCallbacks tbl)     forM_ fdds $ \(FdData reg _ cb) -> cb reg evs   where     -- | Here we look through the list of registrations for the fd of interest-    -- and sort out which match the events that were triggered. We re-arm-    -- the fd as appropriate and return this subset.-    selectCallbacks :: [FdData] -> IO [FdData]-    selectCallbacks fdds = do-        let matches :: FdData -> Bool+    -- and sort out which match the events that were triggered. We,+    --+    --   1. re-arm the fd as appropriate+    --   2. reinsert registrations that weren't triggered and multishot+    --      registrations+    --   3. return a list containing the callbacks that should be invoked.+    selectCallbacks :: IntTable [FdData] -> [FdData] -> IO [FdData]+    selectCallbacks tbl fdds = do+        let -- figure out which registrations have been triggered+            matches :: FdData -> Bool             matches fd' = evs `I.eventIs` I.elEvent (fdEvents fd')-            (triggered, saved) = partition matches fdds+            (triggered, notTriggered) = partition matches fdds++            -- sort out which registrations we need to retain+            isMultishot :: FdData -> Bool+            isMultishot fd' = I.elLifetime (fdEvents fd') == MultiShot+            saved = notTriggered ++ filter isMultishot triggered+             savedEls = eventsOf saved             allEls = eventsOf fdds +        -- Reinsert multishot registrations.+        -- We deleted the table entry for this fd above so we there isn't a preexisting entry+        _ <- IT.insertWith (\_ _ -> saved) (fromIntegral fd) saved tbl+         case I.elLifetime allEls of           -- we previously armed the fd for multiple shots, no need to rearm           MultiShot | allEls == savedEls ->@@ -477,17 +492,18 @@            -- either we previously registered for one shot or the           -- events of interest have changed, we must re-arm-          _ -> do+          _ ->             case I.elLifetime savedEls of               OneShot | haveOneShot ->-                -- if there are no saved events there is no need to re-arm-                unless (OneShot == I.elLifetime (eventsOf triggered)-                        && mempty == savedEls) $+                -- if there are no saved events and we registered with one-shot+                -- semantics then there is no need to re-arm+                unless (OneShot == I.elLifetime allEls+                        && mempty == I.elEvent savedEls) $ do                   void $ I.modifyFdOnce (emBackend mgr) fd (I.elEvent savedEls)               _ ->+                -- we need to re-arm with multi-shot semantics                 void $ I.modifyFd (emBackend mgr) fd                                   (I.elEvent allEls) (I.elEvent savedEls)-            return ()          return triggered 

@@ -235,7 +235,9 @@         _             -> Nothing  mkTextEncoding' :: CodingFailureMode -> String -> IO TextEncoding-mkTextEncoding' cfm enc = case [toUpper c | c <- enc, c /= '-'] of+mkTextEncoding' cfm enc =+  case [toUpper c | c <- enc, c /= '-'] of+  -- UTF-8 and friends we can handle ourselves     "UTF8"    -> return $ UTF8.mkUTF8 cfm     "UTF16"   -> return $ UTF16.mkUTF16 cfm     "UTF16LE" -> return $ UTF16.mkUTF16le cfm@@ -247,8 +249,31 @@     'C':'P':n | [(cp,"")] <- reads n -> return $ CodePage.mkCodePageEncoding cfm cp     _ -> unknownEncodingErr (enc ++ codingFailureModeSuffix cfm) #else-    _ -> Iconv.mkIconvEncoding cfm enc+    -- Otherwise, handle other encoding needs via iconv.++    -- Unfortunately there is no good way to determine whether iconv is actually+    -- functional without telling it to do something.+    _ -> do res <- Iconv.mkIconvEncoding cfm enc+            let isAscii = any (== enc) ansiEncNames+            case res of+              Just e -> return e+              -- At this point we know that we can't count on iconv to work+              -- (see, for instance, Trac #10298). However, we still want to do+              --  what we can to work with what we have. For instance, ASCII is+              -- easy. We match on ASCII encodings directly using several+              -- possible aliases (specified by RFC 1345 & Co) and for this use+              -- the 'ascii' encoding+              Nothing+                | isAscii   -> return (Latin1.mkAscii cfm)+                | otherwise ->+                    unknownEncodingErr (enc ++ codingFailureModeSuffix cfm)+  where+    ansiEncNames = -- ASCII aliases+      [ "ANSI_X3.4-1968", "iso-ir-6", "ANSI_X3.4-1986", "ISO_646.irv:1991"+      , "US-ASCII", "us", "IBM367", "cp367", "csASCII", "ASCII", "ISO646-US"+      ] #endif+  latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8) latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8

@@ -34,9 +34,10 @@ #else  import Foreign-import Foreign.C+import Foreign.C hiding (charIsRepresentable) import Data.Maybe import GHC.Base+import GHC.Foreign (charIsRepresentable) import GHC.IO.Buffer import GHC.IO.Encoding.Failure import GHC.IO.Encoding.Types@@ -96,15 +97,27 @@ char_shift | charSize == 2 = 1            | otherwise     = 2 -iconvEncoding :: String -> IO TextEncoding+iconvEncoding :: String -> IO (Maybe TextEncoding) iconvEncoding = mkIconvEncoding ErrorOnCodingFailure -mkIconvEncoding :: CodingFailureMode -> String -> IO TextEncoding+-- | Construct an iconv-based 'TextEncoding' for the given character set and+-- 'CodingFailureMode'.+--+-- As iconv is missing in some minimal environments (e.g. #10298), this+-- checks to ensure that iconv is working properly before returning the+-- encoding, returning 'Nothing' if not.+mkIconvEncoding :: CodingFailureMode -> String -> IO (Maybe TextEncoding) mkIconvEncoding cfm charset = do-  return (TextEncoding {-                textEncodingName = charset,-                mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix) (recoverDecode cfm) iconvDecode,-                mkTextEncoder = newIConv haskellChar charset                 (recoverEncode cfm) iconvEncode})+    let enc = TextEncoding {+                  textEncodingName = charset,+                  mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix)+                                           (recoverDecode cfm) iconvDecode,+                  mkTextEncoder = newIConv haskellChar charset+                                           (recoverEncode cfm) iconvEncode}+    good <- charIsRepresentable enc 'a'+    return $ if good+               then Just enc+               else Nothing   where     -- An annoying feature of GNU iconv is that the //PREFIXES only take     -- effect when they appear on the tocode parameter to iconv_open:

@@ -15,7 +15,7 @@ -- Stability   :  internal -- Portability :  non-portable ----- UTF-32 Codecs for the IO library+-- Single-byte encodings that map directly to Unicode code points. -- -- Portions Copyright   : (c) Tom Harper 2008-2009, --                        (c) Bryan O'Sullivan 2009,@@ -26,9 +26,12 @@ module GHC.IO.Encoding.Latin1 (   latin1, mkLatin1,   latin1_checked, mkLatin1_checked,+  ascii, mkAscii,   latin1_decode,+  ascii_decode,   latin1_encode,   latin1_checked_encode,+  ascii_encode,   ) where  import GHC.Base@@ -90,7 +93,47 @@              setState = const $ return ()           }) +-- -----------------------------------------------------------------------------+-- ASCII +-- | @since 4.8.2.0+ascii :: TextEncoding+ascii = mkAscii ErrorOnCodingFailure++-- | @since 4.8.2.0+mkAscii :: CodingFailureMode -> TextEncoding+mkAscii cfm = TextEncoding { textEncodingName = "ASCII",+                             mkTextDecoder = ascii_DF cfm,+                             mkTextEncoder = ascii_EF cfm }++ascii_DF :: CodingFailureMode -> IO (TextDecoder ())+ascii_DF cfm =+  return (BufferCodec {+             encode   = ascii_decode,+             recover  = recoverDecode cfm,+             close    = return (),+             getState = return (),+             setState = const $ return ()+          })++ascii_EF :: CodingFailureMode -> IO (TextEncoder ())+ascii_EF cfm =+  return (BufferCodec {+             encode   = ascii_encode,+             recover  = recoverEncode cfm,+             close    = return (),+             getState = return (),+             setState = const $ return ()+          })++++-- -----------------------------------------------------------------------------+-- The actual decoders and encoders++-- TODO: Eliminate code duplication between the checked and unchecked+-- versions of the decoder or encoder (but don't change the Core!)+ latin1_decode :: DecodeBuffer latin1_decode    input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }@@ -112,6 +155,30 @@     in     loop ir0 ow0 +ascii_decode :: DecodeBuffer+ascii_decode+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }+ = let+       loop !ir !ow+         | ow >= os = done OutputUnderflow ir ow+         | ir >= iw = done InputUnderflow ir ow+         | otherwise = do+              c0 <- readWord8Buf iraw ir+              if c0 > 0x7f then invalid else do+              ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))+              loop (ir+1) ow'+         where+           invalid = done InvalidSequence ir ow++       -- lambda-lifted, to avoid thunks being built in the inner-loop:+       done why !ir !ow = return (why,+                                  if ir == iw then input{ bufL=0, bufR=0 }+                                              else input{ bufL=ir },+                                  output{ bufR=ow })+    in+    loop ir0 ow0+ latin1_encode :: EncodeBuffer latin1_encode   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }@@ -132,7 +199,15 @@     loop ir0 ow0  latin1_checked_encode :: EncodeBuffer-latin1_checked_encode+latin1_checked_encode input output+ = single_byte_checked_encode 0xff input output++ascii_encode :: EncodeBuffer+ascii_encode input output+ = single_byte_checked_encode 0x7f input output++single_byte_checked_encode :: Int -> EncodeBuffer+single_byte_checked_encode max_legal_char   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }  = let@@ -145,11 +220,11 @@         | ir >= iw = done InputUnderflow ir ow         | otherwise = do            (c,ir') <- readCharBuf iraw ir-           if ord c > 0xff then invalid else do+           if ord c > max_legal_char then invalid else do            writeWord8Buf oraw ow (fromIntegral (ord c))            loop ir' (ow+1)         where            invalid = done InvalidSequence ir ow     in     loop ir0 ow0-+{-# INLINE single_byte_checked_encode #-}

@@ -323,7 +323,7 @@       ResourceVanished  -> "resource vanished"       SystemError       -> "system error"       TimeExpired       -> "timeout"-      UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!+      UnsatisfiedConstraints -> "unsatisfied constraints" -- ultra-precise!       UnsupportedOperation -> "unsupported operation"  -- | Construct an 'IOError' value with a string describing the error.

@@ -84,8 +84,15 @@ last (_:xs)             =  last xs last []                 =  errorEmptyList "last" #else--- use foldl to allow fusion-last = foldl (\_ x -> x) (errorEmptyList "last")+-- Use foldl to make last a good consumer.+-- This will compile to good code for the actual GHC.List.last.+-- (At least as long it is eta-expaned, otherwise it does not, #10260.)+last xs = foldl (\_ x -> x) lastError xs+{-# INLINE last #-}+-- The inline pragma is required to make GHC remember the implementation via+-- foldl.+lastError :: a+lastError = errorEmptyList "last" #endif  -- | Return all the elements of a list except the last one.

@@ -0,0 +1,33 @@+{-# LANGUAGE RecordWildCards #-}+module GHC.SrcLoc+  ( SrcLoc+  , srcLocPackage+  , srcLocModule+  , srcLocFile+  , srcLocStartLine+  , srcLocStartCol+  , srcLocEndLine+  , srcLocEndCol++  -- * Pretty printing+  , showSrcLoc+  ) where++-- | A single location in the source code.+data SrcLoc = SrcLoc+  { srcLocPackage   :: String+  , srcLocModule    :: String+  , srcLocFile      :: String+  , srcLocStartLine :: Int+  , srcLocStartCol  :: Int+  , srcLocEndLine   :: Int+  , srcLocEndCol    :: Int+  } deriving (Show, Eq)++showSrcLoc :: SrcLoc -> String+showSrcLoc SrcLoc {..}+  = concat [ srcLocFile, ":"+           , show srcLocStartLine, ":"+           , show srcLocStartCol, " in "+           , srcLocPackage, ":", srcLocModule+           ]

@@ -17,11 +17,17 @@  {-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-} module GHC.Stack (-    -- * Call stack+    -- * Call stacks+    -- ** Simulated by the RTS     currentCallStack,     whoCreated,     errorWithStackTrace, +    -- ** Explicitly created via implicit-parameters+    CallStack,+    getCallStack,+    showCallStack,+     -- * Internals     CostCentreStack,     CostCentre,@@ -36,6 +42,8 @@     renderStack   ) where +import Data.List ( unlines )+ import Foreign import Foreign.C @@ -46,6 +54,8 @@ import GHC.IO.Encoding import GHC.Exception import GHC.List ( concatMap, null, reverse )+import GHC.Show+import GHC.SrcLoc  #define PROFILING #include "Rts.h"@@ -128,3 +138,48 @@    if null stack       then throwIO (ErrorCall x)       else throwIO (ErrorCall (x ++ '\n' : renderStack stack))+++----------------------------------------------------------------------+-- Explicit call-stacks built via ImplicitParams+----------------------------------------------------------------------++-- | @CallStack@s are an alternate method of obtaining the call stack at a given+-- point in the program.+--+-- When an implicit-parameter of type @CallStack@ occurs in a program, GHC will+-- solve it with the current location. If another @CallStack@ implicit-parameter+-- is in-scope (e.g. as a function argument), the new location will be appended+-- to the one in-scope, creating an explicit call-stack. For example,+--+-- @+-- myerror :: (?loc :: CallStack) => String -> a+-- myerror msg = error (msg ++ "\n" ++ showCallStack ?loc)+-- @+-- ghci> myerror "die"+-- *** Exception: die+-- ?loc, called at MyError.hs:7:51 in main:MyError+--   myerror, called at <interactive>:2:1 in interactive:Ghci1+--+-- @CallStack@s do not interact with the RTS and do not require compilation with+-- @-prof@. On the other hand, as they are built up explicitly using+-- implicit-parameters, they will generally not contain as much information as+-- the simulated call-stacks maintained by the RTS.+--+-- The @CallStack@ type is abstract, but it can be converted into a+-- @[(String, SrcLoc)]@ via 'getCallStack'. The @String@ is the name of function+-- that was called, the 'SrcLoc' is the call-site. The list is ordered with the+-- most recently called function at the head.+--+-- @since 4.9.0.0+data CallStack = CallStack { getCallStack :: [(String, SrcLoc)] }+  -- See Note [Overview of implicit CallStacks]+  deriving (Show, Eq)++showCallStack :: CallStack -> String+showCallStack (CallStack (root:rest))+  = unlines (showCallSite root : map (indent . showCallSite) rest)+  where+  indent l = "  " ++ l+  showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc+showCallStack _ = error "CallStack cannot be empty!"

@@ -157,13 +157,45 @@            Just (ExitFailure n) -> exit n             -- EPIPE errors received for stdout are ignored (#2699)-           _ -> case fromException se of+           _ -> catch (case fromException se of                 Just IOError{ ioe_type = ResourceVanished,                               ioe_errno = Just ioe,                               ioe_handle = Just hdl }                    | Errno ioe == ePIPE, hdl == stdout -> exit 0                 _ -> do reportError se                         exit 1+                ) (disasterHandler exit) -- See Note [Disaster with iconv]++-- don't use errorBelch() directly, because we cannot call varargs functions+-- using the FFI.+foreign import ccall unsafe "HsBase.h errorBelch2"+   errorBelch :: CString -> CString -> IO ()++disasterHandler :: (Int -> IO a) -> IOError -> IO a+disasterHandler exit _ =+  withCAString "%s" $ \fmt ->+    withCAString msgStr $ \msg ->+      errorBelch fmt msg >> exit 1+  where+    msgStr =+        "encountered an exception while trying to report an exception." +++        "One possible reason for this is that we failed while trying to " +++        "encode an error message. Check that your locale is configured " +++        "properly."++{- Note [Disaster with iconv]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++When using iconv, it's possible for things like iconv_open to fail in+restricted environments (like an initram or restricted container), but+when this happens the error raised inevitably calls `peekCString`,+which depends on the users locale, which depends on using+`iconv_open`... which causes an infinite loop.++This occurrence is also known as tickets #10298 and #7695. So to work+around it we just set _another_ error handler and bail directly by+calling the RTS, without iconv at all.+-}   -- try to flush stdout/stderr, but don't worry if we fail

@@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE CPP, NoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}  ----------------------------------------------------------------------------- -- |@@ -453,13 +453,13 @@ openTempFileWithDefaultPermissions :: FilePath -> String                                    -> IO (FilePath, Handle) openTempFileWithDefaultPermissions tmp_dir template-    = openTempFile' "openBinaryTempFile" tmp_dir template False 0o666+    = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666  -- | Like 'openBinaryTempFile', but uses the default file permissions openBinaryTempFileWithDefaultPermissions :: FilePath -> String                                          -> IO (FilePath, Handle) openBinaryTempFileWithDefaultPermissions tmp_dir template-    = openTempFile' "openBinaryTempFile" tmp_dir template True 0o666+    = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666  openTempFile' :: String -> FilePath -> String -> Bool -> CMode               -> IO (FilePath, Handle)@@ -509,7 +509,7 @@                   | otherwise = a ++ [pathSeparator] ++ b  -- int rand(void) from <stdlib.h>, limited by RAND_MAX (small value, 32768)-foreign import ccall "rand" c_rand :: IO CInt+foreign import capi "stdlib.h rand" c_rand :: IO CInt  -- build large digit-alike number rand_string :: IO String

@@ -1,5 +1,5 @@ name:           base-version:        4.8.0.0+version:        4.8.1.0 -- NOTE: Don't forget to update ./changelog.md license:        BSD3 license-file:   LICENSE@@ -259,6 +259,7 @@         GHC.StaticPtr         GHC.STRef         GHC.Show+        GHC.SrcLoc         GHC.Stable         GHC.Stack         GHC.Stats

@@ -1,5 +1,14 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.8.1.0  *Jul 2015*++  * Bundled with GHC 7.10.2++  * `Lifetime` is now exported from `GHC.Event`++  * Implicit-parameter based source location support exposed in `GHC.SrcLoc`.+    See GHC User's Manual for more information.+ ## 4.8.0.0  *Mar 2015*    * Bundled with GHC 7.10.1