Proposal: Faster conversion between Rational and Double/Float

Daniel Fischer daniel.is.fischer at googlemail.com
Thu Mar 31 21:13:50 CEST 2011


Currently, the conversions between Rational and Double resp. Float are 
rather slow:

Converting 10,000 (pseudo-random) Doubles (from an unboxed array) to Floats 
and summing:

Range -1e308 to 1e308:
- double2Float:
    mean: 4.343703 ms, lb 4.324399 ms, ub 4.382361 ms, ci 0.950
- uncurry encodeFloat . decodeFloat:
    mean: 6.449336 ms, lb 6.427503 ms, ub 6.488190 ms, ci 0.950
- fromRational . toRational:
    mean: 875.3696 ms, lb 874.4413 ms, ub 876.6326 ms, ci 0.950

Range -1e37 to 1e37:
- double2Float:
    mean: 547.6073 us, lb 544.3635 us, ub 559.5245 us, ci 0.950
- uncurry encodeFloat . decodeFloat:
    mean: 2.754600 ms, lb 2.749209 ms, ub 2.768121 ms, ci 0.950
- fromRational . toRational:
    mean: 287.4107 ms, lb 286.9602 ms, ub 288.0782 ms, ci 0.950

So all conversions suffer from large/out of range values, the primop most.
The conversion via fromRational . toRational takes 200 - 500 times as long 
(subtracting array reads and addition, it would probably be much more for 
the conversion itself).

The conversion via the proposed new implementations of toRational and 
fromRational took

- large range:
    mean: 10.89560 ms, lb 10.86049 ms, ub 10.97370 ms, ci 0.950
- small range:
    mean: 7.015212 ms, lb 6.993312 ms, ub 7.068088 ms, ci 0.950

It suffers much less from large/out of range values and is 40 - 80 times 
faster than the old (probably a little more, subtracting array reads and 
additions).

Converting 10,000 Floats to Doubles:
- float2Double:
    mean: 540.6598 us, lb 539.0135 us, ub 545.1019 us, ci 0.950
- uncurry encodeFloat . decodeFloat:
    mean: 1.886183 ms, lb 1.882036 ms, ub 1.896018 ms, ci 0.950
- fromRational . toRational:
    mean: 280.6127 ms, lb 280.2228 ms, ub 281.1654 ms, ci 0.950
- new implementation:
    mean: 5.909890 ms, lb 5.892503 ms, ub 5.961752 ms, ci 0.950
====================================================

One of the key factors for a fast fromRational is a fast integer logarithm 
to base 2.
Since GHC can be built with integer-gmp or integer-simple and a fast 
implementation requires exploiting the low-level representation of 
Integers, I deemed it better to add modules to those packages implementing 
logarithms than adding different source directories to base to choose the 
appropriate one based on a flag, therefore in addition to the patch to 
base, this proposal includes patches to integer-gmp and to integer-simple, 
providing some integer logarithm functions.

All functions have been tested to satisfy the appropriate conditions
(fromRational (toRational x) == x for x Float/Double not NaN; 
toRational/fromRational yield the same values as the old implementation;
base ^ integerLogBase base num <= num &&
  num < base ^ (integerLogBase base num + 1)
for base > 1, num > 0), both with pseudo-random input and selected special 
cases.

The patches have been validated against ghc-7.1.20110329 (no unexpected 
failures in the testsuite which aren't identical without the patches).

Since I have a 32-bit system, it is conceivable that I have a glitch in the 
64-bit code, I'd appreciate testing.


Summary:

I propose
- adding modules implementing integer logarithm functions to integer-gmp 
and integer-simple
- changing the implementation of toRational and fromRational for Double and 
Float using those to become significantly faster.

Period of discussion: two weeks (until 14th April).

Cheers,
Daniel
-------------- next part --------------
2 patches for repository /home/dafis/Haskell/Hacking/ghc/libraries/integer-gmp:

Wed Mar 30 18:18:52 CEST 2011  Daniel Fischer <daniel.is.fischer at googlemail.com>
  * Integer logarithms
  Added modules for fast calculation of integer logarithms needed for fromRational.

Thu Mar 31 01:17:10 CEST 2011  Daniel Fischer <daniel.is.fischer at googlemail.com>
  * Fix Haddock markup

New patches:

[Integer logarithms
Daniel Fischer <daniel.is.fischer at googlemail.com>**20110330161852
 Ignore-this: 1942dbd5378c70da60f79bb3b49fcb37
] {
adddir ./GHC/Integer/Logarithms
addfile ./GHC/Integer/Logarithms.hs
hunk ./GHC/Integer/Logarithms.hs 1
+{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+module GHC.Integer.Logarithms
+    ( integerLogBase#
+    , integerLog2#
+    , wordLog2#
+    ) where
+
+import GHC.Prim
+import GHC.Integer
+import qualified GHC.Integer.Logarithms.Internals as I
+
+-- | Calculate the integer logarithm for an arbitrary base.
+--   The base must be greater than 1, the second argument, the number
+--   whose logarithm is sought, should be positive, otherwise the
+--   result is meaningless.
+--
+-- >
+--   base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
+-- >
+--
+-- for @base > 1@ and @m > 0 at .
+integerLogBase# :: Integer -> Integer -> Int#
+integerLogBase# b m = case step b of
+                        (# _, e #) -> e
+  where
+    step pw =
+      if m `ltInteger` pw
+        then (# m, 0# #)
+        else case step (pw `timesInteger` pw) of
+               (# q, e #) ->
+                 if q `ltInteger` pw
+                   then (# q, 2# *# e #)
+                   else (# q `quotInteger` pw, 2# *# e +# 1# #)
+
+-- | Calculate the integer base 2 logarithm of an 'Integer'.
+--   The calculation is more efficient than for the general case,
+--   on platforms with 32- or 64-bit words much more efficient.
+--
+--  The argument must be strictly positive, that condition is /not/ checked.
+integerLog2# :: Integer -> Int#
+integerLog2# = I.integerLog2#
+
+-- | This function calculates the integer base 2 logarithm of a 'Word#'.
+wordLog2# :: Word# -> Int#
+wordLog2# = I.wordLog2#
addfile ./GHC/Integer/Logarithms/Internals.hs
hunk ./GHC/Integer/Logarithms/Internals.hs 1
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+
+-- Fast integer logarithms to base 2.
+-- integerLog2# and wordLog2# are of general usefulness,
+-- the others are only needed for a fast implementation of
+-- fromRational.
+-- Since they are needed in GHC.Float, we must expose this
+-- module, but it should not show up in the docs.
+
+module GHC.Integer.Logarithms.Internals
+    ( integerLog2#
+    , integerLog2IsPowerOf2#
+    , wordLog2#
+    , roundingMode#
+    ) where
+
+import GHC.Prim
+import GHC.Integer.Type
+
+-- When larger word sizes become common, add support for those,
+-- it is not hard, just tedious.
+#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)
+
+-- Less than ideal implementations for strange word sizes
+
+import GHC.Integer
+
+default ()
+
+-- We do not know whether the word has 30 bits or 128 or even more,
+-- so we cannot start from the top, although that would be much more
+-- efficient.
+-- Count the bits until the highest set bit is found.
+wordLog2# :: Word# -> Int#
+wordLog2# w = go 8# w
+  where
+    go acc u = case u `uncheckedShiftRL#` 8# of
+                0## -> case leadingZeros of
+                        BA ba -> acc -# indexInt8Array# ba (word2Int# u)
+                v   -> go (acc +# 8#) v
+
+-- Assumption: Integer is strictly positive
+integerLog2# :: Integer -> Int#
+integerLog2# (S# i) = wordLog2# (int2Word# i) -- that is easy
+integerLog2# m = case step m (smallInteger 2#) 1# of
+                    (# _, l #) -> l
+  where
+    -- Invariants:
+    -- pw = 2 ^ lg
+    -- case step n pw lg of
+    --   (q, e) -> pw^(2*e) <= n < pw^(2*e+2)
+    --              && q <= n/pw^(2*e) < (q+1)
+    --              && q < pw^2
+    step n pw lg =
+      if n `ltInteger` pw
+        then (# n, 0# #)
+        else case step n (shiftLInteger pw lg) (2# *# lg) of
+              (# q, e #) ->
+                if q `ltInteger` pw
+                  then (# q, 2# *# e #)
+                  else (# q `shiftRInteger` lg, 2# *# e +# 1# #)
+
+-- Calculate the log2 of a positive integer and check
+-- whether it is a power of 2.
+-- By coincidence, the presence of a power of 2 is
+-- signalled by zero and not one.
+integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
+integerLog2IsPowerOf2# m =
+    case integerLog2# m of
+      lg -> if m `eqInteger` (smallInteger 1# `shiftLInteger` lg)
+              then (# lg, 0# #)
+              else (# lg, 1# #)
+
+-- Detect the rounding mode,
+-- 0# means round to zero,
+-- 1# means round to even,
+-- 2# means round away from zero
+roundingMode# :: Integer -> Int# -> Int#
+roundingMode# m h =
+    case smallInteger 1# `shiftLInteger` h of
+      c -> case m `andInteger`
+                ((c `plusInteger` c) `minusInteger` smallInteger 1#) of
+             r ->
+               if c `ltInteger` r
+                 then 2#
+                 else if c `gtInteger` r
+                        then 0#
+                        else 1#
+
+#else
+
+default ()
+
+-- We have a nice word size, we can do much better now.
+
+#if WORD_SIZE_IN_BITS == 32
+
+#define WSHIFT 5
+#define MMASK 31
+
+#else
+
+#define WSHIFT 6
+#define MMASK 63
+
+#endif
+
+-- Assumption: Integer is strictly positive
+-- For small integers, use wordLog#,
+-- in the general case, check words from the most
+-- significant down, once a nonzero word is found,
+-- calculate its log2 and add the number of following bits.
+integerLog2# :: Integer -> Int#
+integerLog2# (S# i) = wordLog2# (int2Word# i)
+integerLog2# (J# s ba) = check (s -# 1#)
+  where
+    check i = case indexWordArray# ba i of
+                0## -> check (i -# 1#)
+                w   -> wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
+
+-- Assumption: Integer is strictly positive
+-- First component is log2 n, second is 0# iff n is a power of two
+integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
+-- The power of 2 test is n&(n-1) == 0, thus powers of 2
+-- are indicated bythe second component being zero.
+integerLog2IsPowerOf2# (S# i) =
+    case int2Word# i of
+      w -> (# wordLog2# w, word2Int# (w `and#` (w `minusWord#` 1##)) #)
+-- Find the log2 as above, test whether that word is a power
+-- of 2, if so, check whether only zero bits follow.
+integerLog2IsPowerOf2# (J# s ba) = check (s -# 1#)
+  where
+    check :: Int# -> (# Int#, Int# #)
+    check i = case indexWordArray# ba i of
+                0## -> check (i -# 1#)
+                w   -> (# wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
+                        , case w `and#` (w `minusWord#` 1##) of
+                            0## -> test (i -# 1#)
+                            _   -> 1# #)
+    test :: Int# -> Int#
+    test i = if i <# 0#
+                then 0#
+                else case indexWordArray# ba i of
+                        0## -> test (i -# 1#)
+                        _   -> 1#
+
+-- Assumption: Integer and Int# are strictly positive, Int# is less
+-- than logBase 2 of Integer, otherwise havoc ensues.
+-- Used only for the numerator in fromRational when the denominator
+-- is a power of 2.
+-- The Int# argument is log2 n minus the number of bits in the mantissa
+-- of the target type, i.e. the index of the first non-integral bit in
+-- the quotient.
+--
+-- 0# means round down (towards zero)
+-- 1# means we have a half-integer, round to even
+-- 2# means round up (away from zero)
+roundingMode# :: Integer -> Int# -> Int#
+roundingMode# (S# i) t =
+    case int2Word# i `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of
+      k -> case uncheckedShiftL# 1## t of
+            c -> if c `gtWord#` k
+                    then 0#
+                    else if c `ltWord#` k
+                            then 2#
+                            else 1#
+roundingMode# (J# _ ba) t =
+    case word2Int# (int2Word# t `and#` MMASK##) of
+      j ->      -- index of relevant bit in word
+        case uncheckedIShiftRA# t WSHIFT# of
+          k ->  -- index of relevant word
+            case indexWordArray# ba k `and#`
+                    ((uncheckedShiftL# 2## j) `minusWord#` 1##) of
+              r ->
+                case uncheckedShiftL# 1## j of
+                  c -> if c `gtWord#` r
+                        then 0#
+                        else if c `ltWord#` r
+                                then 2#
+                                else test (k -# 1#)
+  where
+    test i = if i <# 0#
+                then 1#
+                else case indexWordArray# ba i of
+                        0## -> test (i -# 1#)
+                        _   -> 2#
+
+-- wordLog2# 0## = -1#
+{-# INLINE wordLog2# #-}
+wordLog2# :: Word# -> Int#
+wordLog2# w =
+  case leadingZeros of
+   BA lz ->
+    let zeros u = indexInt8Array# lz (word2Int# u) in
+#if WORD_SIZE_IN_BITS == 64
+    case uncheckedShiftRL# w 56# of
+     a ->
+      if a `neWord#` 0##
+       then 64# -# zeros a
+       else
+        case uncheckedShiftRL# w 48# of
+         b ->
+          if b `neWord#` 0##
+           then 56# -# zeros b
+           else
+            case uncheckedShiftRL# w 40# of
+             c ->
+              if c `neWord#` 0##
+               then 48# -# zeros c
+               else
+                case uncheckedShiftRL# w 32# of
+                 d ->
+                  if d `neWord#` 0##
+                   then 40# -# zeros d
+                   else
+#endif
+                    case uncheckedShiftRL# w 24# of
+                     e ->
+                      if e `neWord#` 0##
+                       then 32# -# zeros e
+                       else
+                        case uncheckedShiftRL# w 16# of
+                         f ->
+                          if f `neWord#` 0##
+                           then 24# -# zeros f
+                           else
+                            case uncheckedShiftRL# w 8# of
+                             g ->
+                              if g `neWord#` 0##
+                               then 16# -# zeros g
+                               else 8# -# zeros w
+
+#endif
+
+-- Lookup table
+data BA = BA ByteArray#
+
+leadingZeros :: BA
+leadingZeros =
+    let mkArr s =
+          case newByteArray# 256# s of
+            (# s1, mba #) ->
+              case writeInt8Array# mba 0# 9# s1 of
+                s2 ->
+                  let fillA lim val idx st =
+                        if idx ==# 256#
+                          then st
+                          else if idx <# lim
+                                then case writeInt8Array# mba idx val st of
+                                        nx -> fillA lim val (idx +# 1#) nx
+                                else fillA (2# *# lim) (val -# 1#) idx st
+                  in case fillA 2# 8# 1# s2 of
+                      s3 -> case unsafeFreezeByteArray# mba s3 of
+                              (# _, ba #) -> ba
+    in case mkArr realWorld# of
+        b -> BA b
hunk ./integer-gmp.cabal 26
     build-depends: ghc-prim
     exposed-modules: GHC.Integer
                      GHC.Integer.GMP.Internals
+                     GHC.Integer.Logarithms
+                     GHC.Integer.Logarithms.Internals
     other-modules: GHC.Integer.Type
     extensions: CPP, MagicHash, UnboxedTuples, NoImplicitPrelude,
                 ForeignFunctionInterface, UnliftedFFITypes
}
[Fix Haddock markup
Daniel Fischer <daniel.is.fischer at googlemail.com>**20110330231710
 Ignore-this: ad1657f7c2e512a41f9d53a77d799013
] hunk ./GHC/Integer/Logarithms.hs 17
 --   whose logarithm is sought, should be positive, otherwise the
 --   result is meaningless.
 --
--- >
---   base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
--- >
+-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
 --
 -- for @base > 1@ and @m > 0 at .
 integerLogBase# :: Integer -> Integer -> Int#

Context:

[Call the final build system phase "final" rather than ""
Ian Lynagh <igloo at earth.li>**20110206203232
 Ignore-this: 929994164005f2449ee56ab8a0c07fab
] 
[Update for changes in GHC's build system
Ian Lynagh <igloo at earth.li>**20110122194756
 Ignore-this: e4e98a7ff8a7800f228f59e9452746cf
] 
[Correct the gmp build phase
Ian Lynagh <igloo at earth.li>**20110117122245
 Ignore-this: bc26aafe9526a942f5a381fb3688d7a9
] 
[Tidy up gmp cleaning
Ian Lynagh <igloo at earth.li>**20110117121224
 Ignore-this: 25007c0d1482705f5390e29a86ed6a66
] 
[Add extensions to LANGUAGE pragmas
Ian Lynagh <igloo at earth.li>**20110111003050] 
[Fix unknown symbol base_ControlziExceptionziBase_patError_info by helping GHC generate smarter core.
Edward Z. Yang <ezyang at mit.edu>**20101204013010
 Ignore-this: df2991ab1f4321c8777af7f7c1415d29
] 
[Add LANGUAGE BangPatterns to modules that use bang patterns
simonpj at microsoft.com**20101112170604
 Ignore-this: bd8280707c084644c185d5fb01e583f0
] 
[Add a rewrite rule for toInt# so literals work right
simonpj at microsoft.com**20101026082955
 Ignore-this: 2e7646769926eebff6e49d84e1271089
 
 See the comments with toInt#, but the key point is
 that we want (fromInteger 1)::Int to yield (I# 1)!
] 
[Follow GHC.Bool/GHC.Types merge
Ian Lynagh <igloo at earth.li>**20101023153631
 Ignore-this: 4ce6102919eccb7335756bd4001a2322
] 
[Bump version number to 0.2.0.2
Ian Lynagh <igloo at earth.li>**20100916170032] 
[Fix compile warning on 32bit machine
David Terei <davidterei at gmail.com>**20100817103407
 Ignore-this: 30b715c759d3721a4651c3c94054813
] 
[fix hashInteger to be the same as fromIntegral, and document it (#4108)
Simon Marlow <marlowsd at gmail.com>**20100813153142
 Ignore-this: 5778949a68115bd65464b2b3d4bf4834
] 
[implement integer2Int# and integer2Word# in Haskell, not foreign prim
Simon Marlow <marlowsd at gmail.com>**20100813152926
 Ignore-this: e06beace47751538e72e7b1615ff6dcf
] 
[Use the stage-specific CONF_CC_OPTS variables
Ian Lynagh <igloo at earth.li>**20100723135933] 
[TAG Haskell 2010 report generated
Simon Marlow <marlowsd at gmail.com>**20100705150919
 Ignore-this: 9e76b0809ef3e0cd86b2dd0efb9c0fb7
] 
Patch bundle hash:
e5680d9c3fb3479e4478757e0dbb7c7d4393d2eb
-------------- next part --------------
2 patches for repository /home/dafis/Haskell/Hacking/ghc/libraries/integer-simple:

Wed Mar 30 23:05:10 CEST 2011  Daniel Fischer <daniel.is.fischer at googlemail.com>
  * Integer logarithms
  Added modules for fast calculation of integer logarithms needed for fromRational.

Thu Mar 31 01:14:34 CEST 2011  Daniel Fischer <daniel.is.fischer at googlemail.com>
  * Fix Haddock markup

New patches:

[Integer logarithms
Daniel Fischer <daniel.is.fischer at googlemail.com>**20110330210510
 Ignore-this: 99e4b078dafb94edcffe026bdcb78a0d
 Added modules for fast calculation of integer logarithms needed for fromRational.
] {
adddir ./GHC/Integer/Logarithms
addfile ./GHC/Integer/Logarithms.hs
hunk ./GHC/Integer/Logarithms.hs 1
+{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+module GHC.Integer.Logarithms
+    ( integerLogBase#
+    , integerLog2#
+    , wordLog2#
+    ) where
+
+import GHC.Prim
+import GHC.Integer
+import qualified GHC.Integer.Logarithms.Internals as I
+
+-- | Calculate the integer logarithm for an arbitrary base.
+--   The base must be greater than 1, the second argument, the number
+--   whose logarithm is sought, should be positive, otherwise the
+--   result is meaningless.
+--
+-- >
+--   base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
+-- >
+--
+-- for @base > 1@ and @m > 0 at .
+integerLogBase# :: Integer -> Integer -> Int#
+integerLogBase# b m = case step b of
+                        (# _, e #) -> e
+  where
+    step pw =
+      if m `ltInteger` pw
+        then (# m, 0# #)
+        else case step (pw `timesInteger` pw) of
+               (# q, e #) ->
+                 if q `ltInteger` pw
+                   then (# q, 2# *# e #)
+                   else (# q `quotInteger` pw, 2# *# e +# 1# #)
+
+-- | Calculate the integer base 2 logarithm of an 'Integer'.
+--   The calculation is more efficient than for the general case,
+--   on platforms with 32- or 64-bit words much more efficient.
+--
+--  The argument must be strictly positive, that condition is /not/ checked.
+integerLog2# :: Integer -> Int#
+integerLog2# = I.integerLog2#
+
+-- | This function calculates the integer base 2 logarithm of a 'Word#'.
+wordLog2# :: Word# -> Int#
+wordLog2# = I.wordLog2#
addfile ./GHC/Integer/Logarithms/Internals.hs
hunk ./GHC/Integer/Logarithms/Internals.hs 1
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+
+-- (Hopefully) Fast integer logarithms to base 2.
+-- integerLog2# and wordLog2# are of general usefulness,
+-- the others are only needed for a fast implementation of
+-- fromRational.
+-- Since they are needed in GHC.Float, we must expose this
+-- module, but it should not show up in the docs.
+
+module GHC.Integer.Logarithms.Internals
+    ( integerLog2#
+    , integerLog2IsPowerOf2#
+    , wordLog2#
+    , roundingMode#
+    ) where
+
+import GHC.Prim
+import GHC.Integer.Type
+import GHC.Integer
+
+default ()
+
+-- When larger word sizes become common, add support for those,
+-- it's not hard, just tedious.
+#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)
+
+-- We don't know whether the word has 30 bits or 128 or even more,
+-- so we can't start from the top, although that would be much more
+-- efficient.
+wordLog2# :: Word# -> Int#
+wordLog2# w = go 8# w
+  where
+    go acc u = case u `uncheckedShiftRL#` 8# of
+                0## -> case leadingZeros of
+                        BA ba -> acc -# indexInt8Array# ba (word2Int# u)
+                v   -> go (acc +# 8#) v
+
+#else
+
+-- This one at least can also be done efficiently.
+-- wordLog2# 0## = -1#
+{-# INLINE wordLog2# #-}
+wordLog2# :: Word# -> Int#
+wordLog2# w =
+  case leadingZeros of
+   BA lz ->
+    let zeros u = indexInt8Array# lz (word2Int# u) in
+#if WORD_SIZE_IN_BITS == 64
+    case uncheckedShiftRL# w 56# of
+     a ->
+      if a `neWord#` 0##
+       then 64# -# zeros a
+       else
+        case uncheckedShiftRL# w 48# of
+         b ->
+          if b `neWord#` 0##
+           then 56# -# zeros b
+           else
+            case uncheckedShiftRL# w 40# of
+             c ->
+              if c `neWord#` 0##
+               then 48# -# zeros c
+               else
+                case uncheckedShiftRL# w 32# of
+                 d ->
+                  if d `neWord#` 0##
+                   then 40# -# zeros d
+                   else
+#endif
+                    case uncheckedShiftRL# w 24# of
+                     e ->
+                      if e `neWord#` 0##
+                       then 32# -# zeros e
+                       else
+                        case uncheckedShiftRL# w 16# of
+                         f ->
+                          if f `neWord#` 0##
+                           then 24# -# zeros f
+                           else
+                            case uncheckedShiftRL# w 8# of
+                             g ->
+                              if g `neWord#` 0##
+                               then 16# -# zeros g
+                               else  8# -# zeros w
+
+#endif
+
+-- Assumption: Integer is strictly positive,
+-- otherwise return -1# arbitrarily
+-- Going up in word-sized steps should not be too bad.
+integerLog2# :: Integer -> Int#
+integerLog2# (Positive digits) = step 0# digits
+  where
+    step acc (Some dig None) = acc +# wordLog2# dig
+    step acc (Some _ digs)   =
+        step (acc +# WORD_SIZE_IN_BITS#) digs
+    step acc None = acc     -- should be impossible, throw error?
+integerLog2# _ = negateInt# 1#
+
+-- Again, integer should be strictly positive
+integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
+integerLog2IsPowerOf2# (Positive digits) = couldBe 0# digits
+  where
+    couldBe acc (Some dig None) =
+        (# acc +# wordLog2# dig, word2Int# (and# dig (minusWord# dig 1##)) #)
+    couldBe acc (Some dig digs) =
+        if eqWord# dig 0##
+           then couldBe (acc +# WORD_SIZE_IN_BITS#) digs
+           else noPower (acc +# WORD_SIZE_IN_BITS#) digs
+    couldBe acc None = (# acc, 1# #) -- should be impossible, error?
+    noPower acc (Some dig None) =
+        (# acc +# wordLog2# dig, 1# #)
+    noPower acc (Some _ digs)   =
+        noPower (acc +# WORD_SIZE_IN_BITS#) digs
+    noPower acc None = (# acc, 1# #) -- should be impossible, error?
+integerLog2IsPowerOf2# _ = (# negateInt# 1#, 1# #)
+
+-- Assumption: Integer and Int# are strictly positive, Int# is less
+-- than logBase 2 of Integer, otherwise havoc ensues.
+-- Used only for the numerator in fromRational when the denominator
+-- is a power of 2.
+-- The Int# argument is log2 n minus the number of bits in the mantissa
+-- of the target type, i.e. the index of the first non-integral bit in
+-- the quotient.
+--
+-- 0# means round down (towards zero)
+-- 1# means we have a half-integer, round to even
+-- 2# means round up (away from zero)
+-- This function should probably be improved.
+roundingMode# :: Integer -> Int# -> Int#
+roundingMode# m h =
+    case smallInteger 1# `shiftLInteger` h of
+      c -> case m `andInteger`
+                ((c `plusInteger` c) `minusInteger` smallInteger 1#) of
+             r ->
+               if c `ltInteger` r
+                 then 2#
+                 else if c `gtInteger` r
+                        then 0#
+                        else 1#
+
+-- Lookup table
+data BA = BA ByteArray#
+
+leadingZeros :: BA
+leadingZeros =
+    let mkArr s =
+          case newByteArray# 256# s of
+            (# s1, mba #) ->
+              case writeInt8Array# mba 0# 9# s1 of
+                s2 ->
+                  let fillA lim val idx st =
+                        if idx ==# 256#
+                          then st
+                          else if idx <# lim
+                                then case writeInt8Array# mba idx val st of
+                                        nx -> fillA lim val (idx +# 1#) nx
+                                else fillA (2# *# lim) (val -# 1#) idx st
+                  in case fillA 2# 8# 1# s2 of
+                      s3 -> case unsafeFreezeByteArray# mba s3 of
+                              (# _, ba #) -> ba
+    in case mkArr realWorld# of
+        b -> BA b
hunk ./integer-simple.cabal 16
     build-depends: ghc-prim
     exposed-modules: GHC.Integer
                      GHC.Integer.Simple.Internals
+                     GHC.Integer.Logarithms
+                     GHC.Integer.Logarithms.Internals
     other-modules: GHC.Integer.Type
     extensions: CPP, MagicHash, BangPatterns, UnboxedTuples,
                 ForeignFunctionInterface, UnliftedFFITypes,
}
[Fix Haddock markup
Daniel Fischer <daniel.is.fischer at googlemail.com>**20110330231434
 Ignore-this: 889a05446a17a7c42ec1a69c67910902
] hunk ./GHC/Integer/Logarithms.hs 17
 --   whose logarithm is sought, should be positive, otherwise the
 --   result is meaningless.
 --
--- >
---   base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
--- >
+-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
 --
 -- for @base > 1@ and @m > 0 at .
 integerLogBase# :: Integer -> Integer -> Int#

Context:

[Add extensions to LANGUAGE pragma
Ian Lynagh <igloo at earth.li>**20110111022527] 
[Follow GHC.Bool/GHC.Types merge
Ian Lynagh <igloo at earth.li>**20101023153842
 Ignore-this: eb0bf266cd02a9a11edd84bb0db02b92
] 
[Pad version to 0.1.0.0
Ian Lynagh <igloo at earth.li>**20090920141930] 
[Add NoImplicitPrelude to the extensions used
Ian Lynagh <igloo at earth.li>**20090722174729] 
[Add an import so the deps get sorted out correctly
Ian Lynagh <igloo at earth.li>**20090722162843] 
[() is now available, so use that instead of our own
Ian Lynagh <igloo at earth.li>**20090722161829] 
[Follow changes in GHC and the other libraries
Ian Lynagh <igloo at earth.li>**20090722131507] 
[Fix conversions between Float/Double and simple-integer
Ian Lynagh <igloo at earth.li>**20080614152452] 
[Sprinkle on some strictness annotations
Ian Lynagh <igloo at earth.li>**20080602193146] 
[Make the Integer type components strict
Ian Lynagh <igloo at earth.li>**20080602185149] 
[Avoid the need for infinite Integers when doing bitwise operations
Ian Lynagh <igloo at earth.li>**20080602184237] 
[Initial commit
Ian Lynagh <igloo at earth.li>**20080425024824] 
Patch bundle hash:
2dd65658fbc6ad9c41448e5a0153165e49c85ade
-------------- next part --------------
1 patch for repository /home/dafis/Haskell/Hacking/ghc/libraries/base:

Wed Mar 30 19:37:07 CEST 2011  Daniel Fischer <daniel.is.fischer at googlemail.com>
  * Faster toRational and fromRational for Float and Double
  A faster implementation of toRational and a new module containing some Utilities for that, and a faster implementation of fromRational, depending on patches logarithms-integer-variant-fromRational.dpatch for fast integer logarithms.

New patches:

[Faster toRational and fromRational for Float and Double
Daniel Fischer <daniel.is.fischer at googlemail.com>**20110330173707
 Ignore-this: 3eda1e5c54043a0c1780453d8e14cdde
 A faster implementation of toRational and a new module containing some Utilities for that, and a faster implementation of fromRational, depending on patches logarithms-integer-variant-fromRational.dpatch for fast integer logarithms.
] {
hunk ./GHC/Float.lhs 45
 import GHC.Real
 import GHC.Arr
 import GHC.Float.RealFracMethods
+import GHC.Float.ConversionUtils
+import GHC.Integer.Logarithms ( integerLogBase# )
+import GHC.Integer.Logarithms.Internals
 
 infixr 8  **
 \end{code}
hunk ./GHC/Float.lhs 196
     fromInteger i = F# (floatFromInteger i)
 
 instance  Real Float  where
-    toRational x        =  (m%1)*(b%1)^^n
-                           where (m,n) = decodeFloat x
-                                 b     = floatRadix  x
+    toRational (F# x#)  =
+        case decodeFloat_Int# x# of
+          (# m#, e# #)
+            | e# >=# 0#                                 ->
+                    (smallInteger m# `shiftLInteger` e#) :% 1
+            | (int2Word# m# `and#` 1##) `eqWord#` 0##   ->
+                    case elimZerosInt# m# (negateInt# e#) of
+                      (# n, d# #) -> n :% shiftLInteger 1 d#
+            | otherwise                                 ->
+                    smallInteger m# :% shiftLInteger 1 (negateInt# e#)
 
 instance  Fractional Float  where
     (/) x y             =  divideFloat x y
hunk ./GHC/Float.lhs 209
-    fromRational x      =  fromRat x
+    fromRational (n:%0)
+        | n == 0        = 0/0
+        | n < 0         = (-1)/0
+        | otherwise     = 1/0
+    fromRational (n:%d)
+        | n == 0        = encodeFloat 0 0
+        | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
+        | otherwise     = fromRat'' minEx mantDigs n d
+          where
+            minEx       = FLT_MIN_EXP
+            mantDigs    = FLT_MANT_DIG
     recip x             =  1.0 / x
 
 -- RULES for Integer and Int
hunk ./GHC/Float.lhs 353
 
 
 instance  Real Double  where
-    toRational x        =  (m%1)*(b%1)^^n
-                           where (m,n) = decodeFloat x
-                                 b     = floatRadix  x
+    toRational (D# x#)  =
+        case decodeDoubleInteger x# of
+          (# m, e# #)
+            | e# >=# 0#                                         ->
+                shiftLInteger m e# :% 1
+            | (int2Word# (toInt# m) `and#` 1##) `eqWord#` 0##   ->
+                case elimZerosInteger m (negateInt# e#) of
+                    (# n, d# #) ->  n :% shiftLInteger 1 d#
+            | otherwise                                         ->
+                m :% shiftLInteger 1 (negateInt# e#)
 
 instance  Fractional Double  where
     (/) x y             =  divideDouble x y
hunk ./GHC/Float.lhs 366
-    fromRational x      =  fromRat x
+    fromRational (n:%0)
+        | n == 0        = 0/0
+        | n < 0         = (-1)/0
+        | otherwise     = 1/0
+    fromRational (n:%d)
+        | n == 0        = encodeFloat 0 0
+        | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
+        | otherwise     = fromRat'' minEx mantDigs n d
+          where
+            minEx       = DBL_MIN_EXP
+            mantDigs    = DBL_MANT_DIG
     recip x             =  1.0 / x
 
 instance  Floating Double  where
hunk ./GHC/Float.lhs 791
 
 \begin{code}
 -- | Converts a 'Rational' value into any type in class 'RealFloat'.
-{-# SPECIALISE fromRat :: Rational -> Double,
-                          Rational -> Float #-}
+{-# RULES
+"fromRat/Float"     fromRat = (fromRational :: Rational -> Float)
+"fromRat/Double"    fromRat = (fromRational :: Rational -> Double)
+  #-}
 fromRat :: (RealFloat a) => Rational -> a
 
 -- Deal with special cases first, delegating the real work to fromRat'
hunk ./GHC/Float.lhs 862
 
 -- Compute the (floor of the) log of i in base b.
 -- Simplest way would be just divide i by b until it's smaller then b, but that would
--- be very slow!  We are just slightly more clever.
+-- be very slow!  We are just slightly more clever, except for base 2, where
+-- we take advantage of the representation of Integers.
+-- The general case could be improved by a lookup table for
+-- approximating the result by integerLog2 i / integerLog2 b.
 integerLogBase :: Integer -> Integer -> Int
 integerLogBase b i
    | i < b     = 0
hunk ./GHC/Float.lhs 869
-   | otherwise = doDiv (i `div` (b^l)) l
-       where
-        -- Try squaring the base first to cut down the number of divisions.
-         l = 2 * integerLogBase (b*b) i
+   | b == 2    = I# (integerLog2# i)
+   | otherwise = I# (integerLogBase# b i)
 
hunk ./GHC/Float.lhs 872
-         doDiv :: Integer -> Int -> Int
-         doDiv x y
-            | x < b     = y
-            | otherwise = doDiv (x `div` b) (y+1)
+\end{code}
 
hunk ./GHC/Float.lhs 874
+Unfortunately, the old conversion code was awfully slow due to
+a) a slow integer logarithm
+b) repeated calculation of gcd's
+
+For the case of Rational's coming from a Float or Double via toRational,
+we can exploit the fact that the denominator is a power of two, which for
+these brings a huge speedup since we need only shift and add instead
+of division.
+
+The below is an adaption of fromRat' for the conversion to
+Float or Double exploiting the know floatRadix and avoiding
+divisions as much as possible.
+
+\begin{code}
+{-# SPECIALISE fromRat'' :: Int -> Int -> Integer -> Integer -> Float,
+                            Int -> Int -> Integer -> Integer -> Double #-}
+fromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a
+fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
+    case integerLog2IsPowerOf2# d of
+      (# ld#, pw# #)
+        | pw# ==# 0# ->
+          case integerLog2# n of
+            ln# | ln# ># (ld# +# me#) ->
+                  if ln# <# md#
+                    then encodeFloat (n `shiftL` (I# (md# -# 1# -# ln#)))
+                                        (I# (ln# +# 1# -# ld# -# md#))
+                    else let n'  = n `shiftR` (I# (ln# +# 1# -# md#))
+                             n'' = case roundingMode# n (ln# -# md#) of
+                                    0# -> n'
+                                    2# -> n' + 1
+                                    _  -> case fromInteger n' .&. (1 :: Int) of
+                                            0 -> n'
+                                            _ -> n' + 1
+                         in encodeFloat n'' (I# (ln# -# ld# +# 1# -# md#))
+                | otherwise ->
+                  case ld# +# (me# -# md#) of
+                    ld'# | ld'# ># (ln# +# 1#)  -> encodeFloat 0 0
+                         | ld'# ==# (ln# +# 1#) ->
+                           case integerLog2IsPowerOf2# n of
+                            (# _, 0# #) -> encodeFloat 0 0
+                            (# _, _ #)  -> encodeFloat 1 (minEx - mantDigs)
+                         | ld'# <=# 0#  ->
+                           encodeFloat n (I# ((me# -# md#) -# ld'#))
+                         | otherwise    ->
+                           let n' = n `shiftR` (I# ld'#)
+                           in case roundingMode# n (ld'# -# 1#) of
+                                0# -> encodeFloat n' (minEx - mantDigs)
+                                1# -> if fromInteger n' .&. (1 :: Int) == 0
+                                        then encodeFloat n' (minEx-mantDigs)
+                                        else encodeFloat (n' + 1) (minEx-mantDigs)
+                                _  -> encodeFloat (n' + 1) (minEx-mantDigs)
+        | otherwise ->
+          let ln = I# (integerLog2# n)
+              ld = I# ld#
+              p0 = max minEx (ln - ld)
+              (n', d')
+                | p0 < mantDigs = (n `shiftL` (mantDigs - p0), d)
+                | p0 == mantDigs = (n, d)
+                | otherwise     = (n, d `shiftL` (p0 - mantDigs))
+              scale p a b
+                | p <= minEx-mantDigs = (p,a,b)
+                | a < (b `shiftL` (mantDigs-1)) = (p-1, a `shiftL` 1, b)
+                | (b `shiftL` mantDigs) <= a = (p+1, a, b `shiftL` 1)
+                | otherwise = (p, a, b)
+              (p', n'', d'') = scale (p0-mantDigs) n' d'
+              rdq = case n'' `quotRem` d'' of
+                     (q,r) -> case compare (r `shiftL` 1) d'' of
+                                LT -> q
+                                EQ -> if fromInteger q .&. (1 :: Int) == 0
+                                        then q else q+1
+                                GT -> q+1
+          in  encodeFloat rdq p'
 \end{code}
 
 
addfile ./GHC/Float/ConversionUtils.hs
hunk ./GHC/Float/ConversionUtils.hs 1
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_GHC -O2 #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Float.ConversionUtils
+-- Copyright   :  (c) Daniel Fischer 2010
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc at haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Utilities for conversion between Double/Float and Rational
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+-- #hide
+module GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where
+
+import GHC.Base
+import GHC.Integer
+import GHC.IntWord64
+
+default ()
+
+#if WORD_SIZE_IN_BITS < 64
+
+#define TO64    integerToInt64
+
+toByte64# :: Int64# -> Int#
+toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))
+
+-- Double mantissae have 53 bits, too much for Int#
+elim64# :: Int64# -> Int# -> (# Integer, Int# #)
+elim64# n e =
+    case zeroCount (toByte64# n) of
+      t | e <=# t   -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)
+        | t <# 8#   -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)
+        | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)
+
+#else
+
+#define TO64    toInt#
+
+-- Double mantissae fit it Int#
+elim64# :: Int# -> Int# -> (# Integer, Int# #)
+elim64# = elimZerosInt#
+
+#endif
+
+{-# INLINE elimZerosInteger #-}
+elimZerosInteger :: Integer -> Int# -> (# Integer, Int# #)
+elimZerosInteger m e = elim64# (TO64 m) e
+
+elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)
+elimZerosInt# n e =
+    case zeroCount (toByte# n) of
+      t | e <=# t   -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)
+        | t <# 8#   -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)
+        | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)
+
+{-# INLINE zeroCount #-}
+zeroCount :: Int# -> Int#
+zeroCount i =
+    case zeroCountArr of
+      BA ba -> indexInt8Array# ba i
+
+toByte# :: Int# -> Int#
+toByte# i = word2Int# (and# 255## (int2Word# i))
+
+
+data BA = BA ByteArray#
+
+-- Number of trailing zero bits in a byte
+zeroCountArr :: BA
+zeroCountArr =
+    let mkArr s =
+          case newByteArray# 256# s of
+            (# s1, mba #) ->
+              case writeInt8Array# mba 0# 8# s1 of
+                s2 ->
+                  let fillA step val idx st
+                        | idx <# 256# = case writeInt8Array# mba idx val st of
+                                          nx -> fillA step val (idx +# step) nx
+                        | step <# 256# = fillA (2# *# step) (val +# 1#) step  st
+                        | otherwise   = st
+                  in case fillA 2# 0# 1# s2 of
+                       s3 -> case unsafeFreezeByteArray# mba s3 of
+                                (# _, ba #) -> ba
+    in case mkArr realWorld# of
+        b -> BA b
hunk ./base.cabal 56
             GHC.Exts,
             GHC.Float,
             GHC.Float.RealFracMethods,
+            GHC.Float.ConversionUtils,
             GHC.ForeignPtr,
             GHC.MVar,
             GHC.IO,
}

Context:

[fix Haddock error
Simon Marlow <marlowsd at gmail.com>**20110329150348
 Ignore-this: 5f3a34b362657ad9a50c1918af2e7b96
] 
[add forkIOWithUnmask, forkOnIOWithUnmask; deprecate forkIOUnmasked
Simon Marlow <marlowsd at gmail.com>**20110329135639
 Ignore-this: 23163e714f45fb9b0cbda979890e3893
     
 With forkIOUnmasked it wasn't possible to reliably set up an exception
 handler in the child thread, because exceptions were immediately
 unmasked.
 
 forkIOWithUnmask   ::        ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId
 forkOnIOWithUnmask :: Int -> ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId
] 
[Add GHC.IO.Handle.FD.openFileBlocking (#4248)
Simon Marlow <marlowsd at gmail.com>**20110329130928
 Ignore-this: 44b67ac69c06540cf1263be21f819750
 like openFile, but opens the file without O_NONBLOCK
] 
[Add allowInterrupt :: IO ()  (#4810)
Simon Marlow <marlowsd at gmail.com>**20101222100149
 Ignore-this: c2edb847cf154e6cbb731a2bce6a032e
 
 docs:
 
 -- | When invoked inside 'mask', this function allows a blocked
 -- asynchronous exception to be raised, if one exists.  It is
 -- equivalent to performing an interruptible operation (see
 -- #interruptible#), but does not involve any actual blocking.
 --
 -- When called outside 'mask', or inside 'uninterruptibleMask', this
 -- function has no effect.
] 
[Fix documentation for mkWeakIORef: argument is finalizer, not key or value
Dmitry Astapov <dastapov at gmail.com>**20110119101445
 Ignore-this: f62f393d96a73253b75549b480e5c8d2
] 
[Work around a limitation in the hsc2hs cross-compilation mode
Ian Lynagh <igloo at earth.li>**20110323234906
 Ignore-this: efad1c056e56ec2e698eed81da4a5629
] 
[Rename System.Event to GHC.Event
Ian Lynagh <igloo at earth.li>**20110321234346
 Ignore-this: 575e2871b3537b67320d1e7b0ce399b1
 It's just an internal GHC library, for now at least
] 
[Never use epoll_create1; fixes trac #5005
Ian Lynagh <igloo at earth.li>**20110312211426
 There is little benefit to using epoll_create1 (especially if we still
 have the epoll_create code too), and it cuases problems if people build
 a GHC binary on one machine and try to use it on another.
] 
[Fix warning
Ian Lynagh <igloo at earth.li>**20110309200609
 Ignore-this: 4103cc9949f702dde609806bd45c710c
] 
[FIX #2271
Daniel Fischer <daniel.is.fischer at web.de>**20101018210337
 Ignore-this: ae53a9cc96244741f54aa2c93f577ecc
 Faster rounding functions for Double and float with Int or Integer results.
 Fixes #2271.
 Since some glibc's have buggy rintf or rint functions and the behaviour of
 these functions depends on the setting of the rounding mode, we provide our
 own implementations which always round ties to even.
 
 Also added rewrite rules and removed trailing whitespace.
] 
[add threadCapability :: ThreadId -> IO (Int,Bool)
Simon Marlow <marlowsd at gmail.com>**20110301103246
 Ignore-this: 4bf123b0023bbb8c2fa644258704013f
 
 -- | returns the number of the capability on which the thread is currently
 -- running, and a boolean indicating whether the thread is locked to
 -- that capability or not.  A thread is locked to a capability if it
 -- was created with @forkOnIO at .
] 
[follow changes to threadStatus#, and update stat values
Simon Marlow <marlowsd at gmail.com>**20101222130024
 Ignore-this: 48152e64ee0756e82c0004d7f06e7794
] 
[Make the Timeout exception a newtype instead of a datatype
Bas van Dijk <v.dijk.bas at gmail.com>**20110215212457
 Ignore-this: 920112d81d3d2d2828d068c7e2ee6715
] 
[improve discussion of the laws (doc comments only)
Ross Paterson <ross at soi.city.ac.uk>**20110228233232
 Ignore-this: 3f6042cdbd88a9ede36bde92c473fab2
 
 following a suggestion of Russell O'Connor on the libraries list.
] 
[Add some more explanation to the skip channel example in the MVar docs
Ian Lynagh <igloo at earth.li>**20110226005144] 
[Grammar fix
Ian Lynagh <igloo at earth.li>**20110225214614
 Ignore-this: 60d37f3b8d6ec2a669c60c0942c047cf
] 
[Expand and clarify MVar documentation.
Edward Z. Yang <ezyang at mit.edu>**20110116192334
 Ignore-this: d8ba6ddc251e418fbb56373e3b948029
] 
[Remove most of GHC.PArr
Manuel M T Chakravarty <chak at cse.unsw.edu.au>**20110218012952
 Ignore-this: 3797ff2b6160b68a84bb6efb0e67b46f
 - First step of migrating this code into the dph package
] 
[Roll back generics changes in the HEAD repos
Ian Lynagh <igloo at earth.li>**20110219133142
 Ignore-this: f673f480d1620cb2af68fabaa3e1b3c6
] 
[Do not export GHC.Generics from GHC.Base
jpm at cs.uu.nl**20101014124240
 Ignore-this: 2a123b988646cd6588ff9ff4b3560a5c
] 
[Fix incorrect #ifdef for nhc98
Malcolm.Wallace at me.com**20110211111728] 
[Add Data.String to the nhc98 build
Malcolm.Wallace at me.com**20110211111634] 
[Regenerated cbits/WCsubst.c based on Unicode 6.0.0
Bas van Dijk <v.dijk.bas at gmail.com>**20110207193149
 Ignore-this: 596f4b97180227f5b53beeaaaf31ec3
] 
[Deprecate System.IO.Error.{catch,try} and Prelude.catch; fixes trac #4865
Ian Lynagh <igloo at earth.li>**20110205155354
 Ignore-this: b519752cb27400a30098847b799e8c38
] 
[add getNumCapabilities :: IO Int
Simon Marlow <marlowsd at gmail.com>**20101222125953
 Ignore-this: 61ab953e6f0eb01965bd857d15da2824
   
 If we ever get around to implementing #3729 and #3210, then the number
 of capabilities will vary at runtime, so we need to move
 numCapabilities into the IO monad.
] 
[add missing extensions for Windows
Simon Marlow <marlowsd at gmail.com>**20110131143258
 Ignore-this: 23edb9bee415490a0826c4b2305ceeb9
] 
[add NoImplicitPrelude (fix Windows build failure)
Simon Marlow <marlowsd at gmail.com>**20110131135209
 Ignore-this: 9d7d1b5f81cb46a6cdd0f33ab8a1ae31
] 
[Use explicit language extensions & remove extension fields from base.cabal
simonpj at microsoft.com**20110128120719
 Ignore-this: 9f009b6a9536276e90fb4e3e10dda8f0
 
 Add explicit {-# LANGUAGE xxx #-} pragmas to each module, that say
 what extensions that module uses.  This makes it clearer where
 different extensions are used in the (large, variagated) base package.
 
 Now base.cabal doesn't need any extensions field
 
 Thanks to Bas van Dijk for doing all the work.
] 
[fix silly mistake in hGetBufSome (#4895)
Simon Marlow <marlowsd at gmail.com>**20110121143555
 Ignore-this: 54a632de9f2826c861c98a7eeb72aab2
] 
[Clean up remnants of the Event Manager after forkProcess. Closes #4449
Dmitry Astapov <dastapov at gmail.com>**20110119103300
 Ignore-this: eac4a80629d51a80e29d904c05c886e4
] 
[Document System.Event
Johan Tibell <johan.tibell at gmail.com>**20110112125430
 Ignore-this: 737fefdd3e2d6ac2a30dca40fd5af40a
] 
[Add NondecreasingIndentation to the extensions needed
Ian Lynagh <igloo at earth.li>**20110117184820
 Ignore-this: cc65b5c32ae8d13bed7a90c835d2ef6a
] 
[Remove extensions required for GHC < 6.10
Ian Lynagh <igloo at earth.li>**20110117184715
 Ignore-this: e444b273e6c4edd8447f2d592f9a9079
] 
[Added a Typeable instance for SampleVar
Bas van Dijk <v.dijk.bas at gmail.com>**20101127091151
 Ignore-this: 43f1e6ff8d0c278724c6437c5c06386b
] 
[Derived Eq instance for QSem and QSemN
Bas van Dijk <v.dijk.bas at gmail.com>**20101201080307
 Ignore-this: c1d164b1a5740adffb430924ffc96a0c
] 
[Derived Eq instance for Chan
Bas van Dijk <v.dijk.bas at gmail.com>**20101125210240
 Ignore-this: 45c0f1cde9b77739bd8fce02318f32c3
] 
[fix #4876
Simon Marlow <marlowsd at gmail.com>**20110106154654
 Ignore-this: 420925b083e396b48ca4bc41f82ea355
] 
[Instances for ST not available in nhc98.
Malcolm.Wallace at me.com**20110104125142
 Ignore-this: ef97b7ecda6dda089c2a065a7c9d4cfd
] 
[indentation tweaks (whitespace only)
Ross Paterson <ross at soi.city.ac.uk>**20110103195201
 Ignore-this: 1fb5255f40acf275e093f32607417ba0
] 
[indentation tweaks, re-order exports
Ross Paterson <ross at soi.city.ac.uk>**20110103194206
 Ignore-this: f1f33575115ca59e933201d3aa3a36b8
] 
[Add Applicative instances for ST monads (proposal #4455)
Ross Paterson <ross at soi.city.ac.uk>**20110103185722
 Ignore-this: 4a63bf48a5d65b617c92b630541bf4f8
 
 patch from Bas van Dijk
] 
[Always use 8k buffers instead of BUFSIZ
Simon Marlow <marlowsd at gmail.com>**20101221155154
 Ignore-this: e5960afc3bf77290e098e2b51ac59c5c
 This makes a huge difference to I/O performance for me on Windows,
 where BUFSIZ is 512.  It might help on Mac too.
] 
[Replace uses of the old catch function with the new one
Ian Lynagh <igloo at earth.li>**20101218213553] 
[Fix build on Windows
Ian Lynagh <igloo at earth.li>**20101213235837] 
[Fix warnings
Ian Lynagh <igloo at earth.li>**20101213132446
 Ignore-this: a5daa167e029170eaec0708352edc7ff
] 
[Use onException for exception cleanup, and mask async exceptions
Bryan O'Sullivan <bos at serpentine.com>**20101206005222
 Ignore-this: ad60d2beef813e6b18bfde711d86d2fb
] 
[Drop closeFd from Control.Concurrent, rename to closeFdWith
Bryan O'Sullivan <bos at serpentine.com>**20101206004124
 Ignore-this: c30c2c577f61018966e17208a2718abc
] 
[Fix #4533 - unregister callbacks on exception, fixing a memory leak
Bryan O'Sullivan <bos at serpentine.com>**20101127181826
 Ignore-this: c37da82a058637c285a2b2fee4eee217
 
 Our problem here was that if a thread blocked in threadWait or
 threadDelay and was killed by an exception thrown from another thread,
 its registration with the IO manager would not be cleared.
 
 The fix is simply to install exception handlers that do the cleanup and
 propagate the exception.
 
] 
[Drop System.Mem.Weak's dependency on Prelude
Bryan O'Sullivan <bos at serpentine.com>**20101127060425
 Ignore-this: e33216175ae42fe438d8be153cef0fd9
] 
[Fix #4514 - IO manager deadlock
Bryan O'Sullivan <bos at serpentine.com>**20101126232810
 Ignore-this: 9deacf960c78c797ef6859b60ca9922
 
 * The public APIs for threadWaitRead and threadWaitWrite remain unchanged,
   and now throw an IOError if a file descriptor is closed behind their
   backs.  This behaviour is documented.
 
 * The GHC.Conc API is extended to add a closeFd function, the behaviour
   of which is documented.
 
 * Behind the scenes, we add a new evtClose event, which is used only when
   one thread closes a file descriptor that other threads are blocking on.
 
 * Both base's IO code and network use the new closeFd function.
 
] 
[Bump the version of base
Bryan O'Sullivan <bos at serpentine.com>**20101126232756
 Ignore-this: deae33d1f0411b39d2f04e3e3e4e3598
] 
[Cache for powers of 10
Daniel Fischer <daniel.is.fischer at web.de>**20101024190707
 Ignore-this: 53f2a3b3a3303c2b70dfc0838ac9c712
 Add a cache for commonly needed powers of 10 to speed up floatToDigits.
] 
[Fix typo in floatToDigits
Daniel Fischer <daniel.is.fischer at web.de>**20101024185041
 Ignore-this: b8124de42645db04f3f8067fb77b87de
 The mDn value for powers of 2 >= floatDigits x - 1 was typo'ed, leading to longer than necessary show results in a few cases (e.g. 2.0^852).
 Corrected in accordance with Burger and Dybvig's paper.
] 
[Performance enchancement for floatToDigits
Daniel Fischer <daniel.is.fischer at web.de>**20101024185914
 Ignore-this: fccbea500820219f755412f1e6af4be
 Use quot and quotRem instead of div and divMod for dividing positive Integers since that is a bit faster.
] 
[FIX #4383
Daniel Fischer <daniel.is.fischer at web.de>**20101024182942
 Ignore-this: 340935fb5bde7a2f9446235ce502295a
 Use a better approximation to logBase 10 2 to prevent leading zeros in floatToDigits.
] 
[Add a Read instance for Data.Fixed.Fixed
Ian Lynagh <igloo at earth.li>**20101116211910] 
[Also export lines, words, unlines and unwords from Data.String
Bas van Dijk <v.dijk.bas at gmail.com>**20101018210317
 Ignore-this: 43f8b96a8a0934de94ba4fea26d7b562
] 
[Do not export String from Data.Char
Bas van Dijk <v.dijk.bas at gmail.com>**20101018205632
 Ignore-this: bb9e0306c371f7c455be7799131c056d
] 
[Export String from Data.String
Bas van Dijk <v.dijk.bas at gmail.com>**20101018204939
 Ignore-this: 2c860e0e88a5371f5c37ffc4e7148743
] 
[extend the documentation about interruptible operations
Simon Marlow <marlowsd at gmail.com>**20101201131917
 Ignore-this: 95d1f0595a8b0f1ce977064ba544fa1b
] 
[fix a discarded exception in hClose
Simon Marlow <marlowsd at gmail.com>**20101201130847
 Ignore-this: 7b023ae78d7edf356bafe02676769eec
] 
[-XPArr is now -XParallelArrays
Ben Lippmeier <benl at ouroborus.net>**20101130085931
 Ignore-this: b5529a189862387e291739f8b55bfa17
] 
[check for ClosedHandle in read/write operations on DuplexHandles (#4808)
Simon Marlow <marlowsd at gmail.com>**20101201105114
 Ignore-this: 434443d3e31ea2ca3c5ee189c1318389
] 
[Fix typo
Bryan O'Sullivan <bos at serpentine.com>**20101126200841
 Ignore-this: fc81cd0e820931df6dc87c52751594ef
] 
[fix hTell behaviour with Unicode Handles
Simon Marlow <marlowsd at gmail.com>**20101125121831
 Ignore-this: bb6fefd609a30c106e877783e0f9e0a4
] 
[Encode immediately in hPutStr and hPutChar
Simon Marlow <marlowsd at gmail.com>**20101125102520
 Ignore-this: 1503393cde63dd99a1e8c9d716bcbe10
 This means that decoding errors will be detected accurately, and can
 be caught and handled.  Overall the implementation is simpler this way
 too.
 
 It does impose a performance hit on small hPutStrs, although larger
 hPutStrs seem to be unaffected.  To compensate somewhat, I optimised
 hPutStrLn.
] 
[Don't throw an error if the output buffer had no room
Simon Marlow <marlowsd at gmail.com>**20101124164221
 Ignore-this: 45023b77b7d107daae552d36701a225a
 This is consistent with the other codecs, and will be relied on by
 some upcoming changes in the IO library.
] 
[use LANGUAGE instead of OPTIONS_GHC
Simon Marlow <marlowsd at gmail.com>**20101124162530
 Ignore-this: b72019eeeb706f366706578a45b22d46
] 
[doc fix: don't refer to unblock.
Simon Marlow <marlowsd at gmail.com>**20101108133212
 Ignore-this: 52da909a3d262dda2c5f8e616da8ace3
] 
[Remove unused import on Windows
Ian Lynagh <igloo at earth.li>**20101120191432
 Ignore-this: 1d58c156f7c1884122ab957c1cb4328c
] 
[Remove an unnecessary fromIntegral
Ian Lynagh <igloo at earth.li>**20101120191052
 Ignore-this: 782b98c388086bd21cd3c33093938855
] 
[Remove a redundant fromIntegral
Ian Lynagh <igloo at earth.li>**20101120185837
 Ignore-this: 7ec9d1fe7c8f0c66b1ceaccf3f8b94ad
] 
[Make (^) and (^^) INLINABLE
simonpj at microsoft.com**20101117100510
 Ignore-this: 111eececad91a198254c8976b4c26a3d
 
 This makes them perform well robustly
 (e.g. in test perf/should_run/MethSharing)
 rather than relying on a rather delicate
 let-floating.  See Note [Inlining (^) in Real.lhs
] 
[TAG 2010-11-18
Ian Lynagh <igloo at earth.li>**20101118011615
 Ignore-this: a5e79170bccf94dc72191a79cf756be7
] 
[Remove redundant fromIntegral
simonpj at microsoft.com**20101117225716
 Ignore-this: 5a3e86b12cc9c9959d70d954f065cd
] 
[Fixing uses of fromIntegral for Windows
dimitris at microsoft.com**20101117183351] 
[Catch exceptions in current thread and throw them to the forked thread in runInUnboundThread
Bas van Dijk <v.dijk.bas at gmail.com>**20101014212723
 Ignore-this: 6ed2952a3fa00d11055b61ed60f55ea8
] 
[There's no need to explicitly check for blocked status in runInUnboundThread when we have mask
Bas van Dijk <v.dijk.bas at gmail.com>**20101014212325
 Ignore-this: 22ca4c9eb3a476b6f83e612cccbac8ab
] 
[Use throwIO instead of throw in runInBoundThread and runInUnboundThread
Bas van Dijk <v.dijk.bas at gmail.com>**20101014210546
 Ignore-this: 8f8716fc3b565bdb11c68856663793c5
] 
[Remove unnecessary fromIntegral calls
simonpj at microsoft.com**20101116172451
 Ignore-this: 8c44dc2b381c050d4eaaf287bbc55b9
] 
[Add some comments to the generated Table.hs
Ian Lynagh <igloo at earth.li>**20101113123430] 
[System.Event.KQueue conditionally uses BangPatterns
Ian Lynagh <igloo at earth.li>**20101113114825] 
[Add LANGUAGE BangPatterns to modules that use bang patterns
simonpj at microsoft.com**20101112170543
 Ignore-this: 30f36b61c29a5fbbfc70b97143ebb4a8
] 
[Reimplement firstPowerOf2
Johan Tibell <johan.tibell at gmail.com>**20101103094630
 Ignore-this: cc4f6ebe52f19ddc34d5e6412753d399
] 
[Remove redundant import
Ian Lynagh <igloo at earth.li>**20101031162520
 Ignore-this: 7fd90d2c844e28f7100c0d803d527953
] 
[Re-gen GHC/IO/Encoding/CodePage/Table.hs
Ian Lynagh <igloo at earth.li>**20101031162034
 Ignore-this: f8885db176f81b296f8dd8bb3146c05b
] 
[Add a Makefile for MakeTable, and remove GHC.Num generated import
Ian Lynagh <igloo at earth.li>**20101031161732
 Ignore-this: 4459f6b29a58978ab56af31bdb888280
] 
[Fix whitespace in codepages/MakeTable.hs
Ian Lynagh <igloo at earth.li>**20101031154953
 Ignore-this: 7d280cf26429de8a51947c2690d63b33
] 
[Add an INLINE pragma on fromInteger on Int
simonpj at microsoft.com**20101027193931
 Ignore-this: 6363b8e1338f1e5334c28e8967284ef3
] 
[Add an INLINE pragme for fmapDefault
simonpj at microsoft.com**20101027193859
 Ignore-this: 5f140c8fe79bbe1fa6af933fb58366bb
] 
[hGetBuf: fix a case of a short read being returned (#4427)
Simon Marlow <marlowsd at gmail.com>**20101027144324
 Ignore-this: 6aa4cf722bef8eb01dfec3e751fd3eeb
] 
[Refer to 'mask' instead of 'block' in documentation of Control.Exception
Bas van Dijk <v.dijk.bas at gmail.com>**20101016185312
 Ignore-this: cd1bc58df53f3cd1078b9031c3c13f4e
] 
[Add showMultiLineString to GHC.Show
simonpj at microsoft.com**20101025151655
 Ignore-this: eacc594597387e8d965d17204b3ae35f
 
 This is part of the fix for #4436
 
   showMultiLineString :: String -> [String]
   -- | Like 'showLitString' (expand escape characters using Haskell
   -- escape conventions), but 
   --   * break the string into multiple lines
   --   * wrap the entire thing in double quotes
   -- Example:  @breakMultiLineString "hello\ngoodbye\nblah"@ 
   -- returns   @["\"hello\\", "\\goodbye\\", "\\blah\"" ]@
   -- where those "\\" are really just a single backslash
   -- (but I'm writing them here as Haskell literals)
] 
[CIntPtr, CUIntPtr, CIntMax, CUIntMax are new to nhc98.
Malcolm.Wallace at me.com**20101025102644
 Ignore-this: 32d703e70b9d0136cd68fa1987b35c2c
] 
[Follow GHC.Bool/GHC.Types merge
Ian Lynagh <igloo at earth.li>**20101023151510
 Ignore-this: e8b93b702f02a4709706b130988f85a8
] 
[Remove redundant imports, now that NoImplicitPrelude does not imply RebindableSyntax
simonpj at microsoft.com**20101022143157
 Ignore-this: 8d11a7ea4625d4d9cd1514e7fe158626
] 
[FIX #4335
Daniel Fischer <daniel.is.fischer at web.de>**20101019010109
 Ignore-this: 3b8ad075637088df77937b923f623204
 fromRational :: Rational -> Ratio a produced invalid results for fixed-width
 types a. Reduce the fraction to avoid that.
] 
[FIX #4337
Daniel Fischer <daniel.is.fischer at web.de>**20101019003030
 Ignore-this: e6eee4088d63e8d72d5ca7d92f708705
 Special versions for the power functions with a Rational base and rewrite rules.
] 
[remove trailing whitespace
Simon Marlow <marlowsd at gmail.com>**20101021093337
 Ignore-this: dda2815ba424a460ba2a31771a3f03fc
] 
[FIX #4336
Daniel Fischer <daniel.is.fischer at web.de>**20101021093246
 Ignore-this: 76031829aff90251a284dbfa72f3b128
 Avoid superfluous gcd calculation in recip for Ratio a because numerator
 and denominator are known to be coprime.
] 
[Add throwSTM :: Exception e => e -> STM a
Bas van Dijk <v.dijk.bas at gmail.com>**20100926192144
 Ignore-this: c6bfdae0eab9f0cf1360bc06d088bfd5
] 
[Generalize catchSTM
Bas van Dijk <v.dijk.bas at gmail.com>**20100926192106
 Ignore-this: d2038494582d2cde2247293dd162671c
] 
[FIX #4334
Daniel Fischer <daniel.is.fischer at web.de>**20101020091111
 Ignore-this: 1a1a406fcf4c352b5bc1f46f93f31b2a
 Make selector thunks visible to GHC to fix a space leak in lines.
] 
[FIX #1434
Daniel Fischer <daniel.is.fischer at web.de>**20101020091014
 Ignore-this: 3c7c73d3f4487d5aaa453087497d3534
 Rewrite rules for RealFrac methods with sized Int and Word targets.
 For all types whose range is contained in Int's range, there are now
 rewrite rules for properFraction, truncate, floor, ceiling and round
 from Double and Float, going through the specialised methods for Int.
 
 Unfortunately, we can't have a rewrite rule for Word.
] 
[Define SpecConstrAnnotation in GHC.Exts, and import it from there
simonpj at microsoft.com**20101018135857
 Ignore-this: 8bf81cbc5787dbb5a3875b5622f67732
   
 Reason: avoid having to link the entire ghc package in modules
 that use compile-time annotations:
   
        import GHC.Exts( SpecConstrAnnotation )
        {-# ANN type T ForceSpecConstr #-}
   
 It's a kind of bug that the package exporting SpecConstrAnnotation
 is linked even though it is only needed at compile time, but putting
 the data type declaration in GHC.Exts is a simple way to sidestep
 the problem
   
 See See Note [SpecConstrAnnotation] in SpecConstr
] 
[throwTo: mention interruptible foreign calls
Simon Marlow <marlowsd at gmail.com>**20101014084220
 Ignore-this: dbc53d85f870cf649f87186c7185465a
] 
[remove trailing whitespace
Simon Marlow <marlowsd at gmail.com>**20101013101906
 Ignore-this: b8b424540cacbbb3c6d934242e3af795
] 
[FIX #4381
Simon Marlow <marlowsd at gmail.com>**20101013101849
 Ignore-this: f0daa4845eeb444231451b975b71d055
 Fix scaleFloat by clamping the scaling parameter so that
 exponent + scale doesn't overflow.
 
 Patch by: Daniel Fischer <daniel.is.fischer at web.de>
] 
[Replaced some throws to throwIOs where the type is IO
Bas van Dijk <v.dijk.bas at gmail.com>**20100924221340
 Ignore-this: e74191e4527ae6f7551c95fd41063335
] 
[Added initial .authorspellings
Bas van Dijk <v.dijk.bas at gmail.com>**20101005072701
 Ignore-this: 63628bcabfdd0b7beda4cd37daeccd89
] 
[Lazier intersperse
Daniel Fischer <daniel.is.fischer at web.de>**20101002231201
 Ignore-this: a0fed65930cf19e68b4363381a5ab576
 A lazier implementation of intersperse, and consequentially intercalate, to
 avoid space leaks.
] 
[FIX #4228 (atanh (-1) returns NaN instead of -Infinity)
ghc at cainnorris.net**20100816213654
 Ignore-this: dee89c24493e84a02bea711a1c83a73f
] 
[Make intersectBy lazier
Daniel Fischer <daniel.is.fischer at web.de>**20100930191731
 Ignore-this: ef687bc75923434e85c14b57171576aa
 Add shortcuts to intersectBy for empty list arguments.
 In addition to being faster in that case, more inputs yield defined results.
 Treats ticket #4323
] 
[doc tweak for Directory file type: file names are '\0'-separated
Simon Marlow <marlowsd at gmail.com>**20100922113811
 Ignore-this: 96b7b004bd6e5bc3e958ad55bf238ba1
] 
[documentation for IODeviceType (#4317, edited by me)
Simon Marlow <marlowsd at gmail.com>**20100915131341
 Ignore-this: 21c50ca7a189eebcf299523b6e942bae
] 
[Allow Data.HashTable construction with user-supplied size
**20100722210726
 Ignore-this: bd54880bb16a106a992f03b040dc4164
 
 This avoids some resizing for users who know they will be inserting a
 lot of data.
 
 http://hackage.haskell.org/trac/ghc/ticket/4193
] 
[some fixes for hGetBufSome
Simon Marlow <marlowsd at gmail.com>**20100916113732
 Ignore-this: 3e596a606c180dc4859ea8f4c9132ca1
  - fix one case where it was blocking when it shouldn't
  - a couple of error-message tweaks
] 
[Windows: map ERROR_NO_DATA to EPIPE, rather than EINVAL
Simon Marlow <marlowsd at gmail.com>**20100915142618
 Ignore-this: 9023e5f0542419f225aef26cb6b1d88d
 WriteFile() returns ERROR_NO_DATA when writing to a pipe that is
 "closing", however by default the write() wrapper in the CRT maps this
 to EINVAL so we get confusing things like
 
   hPutChar: invalid argument (Invalid Argumnet)
 
 when piping the output of a Haskell program into something that closes
 the pipe early.  This was happening in the testsuite in a few place.
 
 The solution is to map ERROR_NO_DATA to EPIPE correctly, as we
 explicitly check for EPIPE on stdout (in GHC.TopHandler) so we can
 exit without an error in this case.
] 
[tighten up parsing of numbers (#1579)
Simon Marlow <marlowsd at gmail.com>**20100913214733
 Ignore-this: 3411bf3d2e98cfacb9e0afd11d79e722
] 
[Add absentError.  
simonpj at microsoft.com**20100914134639
 Ignore-this: d0eef5a87e1def4cdbde92a55241c8c4
 
 This patch accompanies the HEAD patch:
 
   Tue Sep 14 12:38:27 BST 2010  simonpj at microsoft.com
     * Make absent-arg wrappers work for unlifted types (fix Trac #4306)
     
     Previously we were simply passing arguments of unlifted
     type to a wrapper, even if they were absent, which was
     stupid.
     
     See Note [Absent error Id] in WwLib.
] 
[Add missing import, fixes build on windows
simonpj at microsoft.com**20100914122750
 Ignore-this: 12ece15ef94982ddfbf5f9f7900619da
] 
[Add a suitable Show instance for TextEncoding (#4273)
Simon Marlow <marlowsd at gmail.com>**20100913154459
 Ignore-this: 77f2235460895debd2827f34c42c3435
] 
[don't fill a finalized handle with an error (see comment)
Simon Marlow <marlowsd at gmail.com>**20100913153350
 Ignore-this: c72cdb6898dffa88eca1d781171b2943
] 
[deriving (Eq, Ord, Read, Show) for Newline and NewlineMode
Simon Marlow <marlowsd at gmail.com>**20100913153031
 Ignore-this: 9b9b29bfb7abf5550cfbfa7788f81bf
] 
[fix warning on Windows
Simon Marlow <marlowsd at gmail.com>**20100913111536
 Ignore-this: dacc5448c452daad60ed37a1a5ed096e
] 
[Put the state-token argument on fill, done, adjust on the RHS
simonpj at microsoft.com**20100913101832
 Ignore-this: d228b492de7d4635c026ed24cbc17e34
 
 This is so that the functions will inline when
 applied to their normal (non-state-token) aguments.
 
 I forget why I did this, but it seems like the right thing anyway.
] 
[avoid Foreign.unsafePerformIO
Ross Paterson <ross at soi.city.ac.uk>**20100909125521
 Ignore-this: b698101119ffd1bc6311cce0736f745d
] 
[Remove debugging code accidentally left in
Simon Marlow <marlowsd at gmail.com>**20100909113331
 Ignore-this: 906a14176dd37030b8203782a687936b
] 
[Fix Windows build; patches frmo ezyang
Ian Lynagh <igloo at earth.li>**20100908123037
 Ignore-this: 2f02986087edd7da8382221012c27cd0
] 
[More accurate isatty test for MinGW.
Edward Z. Yang <ezyang at mit.edu>**20100907154144
 Ignore-this: 93bdc2b2a8e65a7c4c7d3906bdda01db
] 
[Fix the build when HAVE_KQUEUE but not HAVE_KEVENT64
Ian Lynagh <igloo at earth.li>**20100904223703] 
[Fix warnings
benl at ouroborus.net**20100830044741
 Ignore-this: 8397aaec7c36046c9ace403e65f32d32
] 
[fix cache variable name used by FP_SEARCH_LIBS_PROTO
Ross Paterson <ross at soi.city.ac.uk>**20100819204858
 Ignore-this: b8113cb3c6f0e03c507297c99d3d82b7
] 
[Add a missing castPtr (only shows up in -DDEBUG)
simonpj at microsoft.com**20100815145127
 Ignore-this: 30b9c42cd3ce7837bdabd254fe66078d
] 
[Fixed a rounding error in threadDelay
Johan Tibell <johan.tibell at gmail.com>**20100813124043
 Ignore-this: 1cb77d0852233ffffb144b134064ee3c
] 
[export allocaBytesAligned; make allocaArray use the correct alignment (#2917)
Simon Marlow <marlowsd at gmail.com>**20100812105524
 Ignore-this: deb6495f7b7b84deaf02b88927a5ba8c
] 
[deprecate unGetChan and isEmptyChan (see #4154)
Simon Marlow <marlowsd at gmail.com>**20100705125952
 Ignore-this: b4e769959f131b2d0001eb7202bc1b92
] 
[Add type signatures to cope with lack of local generalisation
simonpj at microsoft.com**20100728124847
 Ignore-this: d3af9a47c2821c6081bde05a135a92fb
] 
[Add type signature in local where
simonpj at microsoft.com**20100727151532
 Ignore-this: 1c57063ad32d13e0d1ec8daf968bf055
] 
[Integrated new I/O manager
Simon Marlow <marlowsd at gmail.com>**20100810082248
 Ignore-this: ed70a9066ac9b676a446fe99978fef7a
 (patch originally by Johan Tibell <johan.tibell at gmail.com>, minor merging by me)
] 
[Add mfilter to Control.Monad
jon.fairbairn at cl.cam.ac.uk**20090917145616
 Ignore-this: de4240b60684f3065b29378df3ea98f2
 
 Straightforward MonadPlus version of List.filter. I would
 prefer to call it filter, but the current naming scheme for
 Control.Monad implies mfilter.
 
] 
[move Monad and MonadFix instances for Either from mtl (proposal #4159)
Ross Paterson <ross at soi.city.ac.uk>**20100729122449
 Ignore-this: b0f8cd8643679948d1da43bd7c08c5aa
 
 The Monad and MonadFix instances for Either (formerly in the mtl
 package) are moved to Control.Monad.Instances and Control.Monad.Fix
 respectively.  The Monad instance is still an orphan, to retain Haskell
 98 compatibility, but the MonadFix instance is together with its class.
 The Error constraint is removed from both instances, and the default
 definition of fail is used.
] 
[Remove egregious ghc-ish from Foreign.Marshal
Malcolm.Wallace at me.com**20100722075449] 
[add numSparks :: IO Int (#4167)
Simon Marlow <marlowsd at gmail.com>**20100720153858
 Ignore-this: 4543f57a7f137f8cae1c3efc5c023a9b
] 
[add unsafeLocalState from Haskell 2010, and docs
Simon Marlow <marlowsd at gmail.com>**20100720082819
 Ignore-this: dcd79fb546ebe29ddff4df279ec2f38
] 
[docs: mention that Foreign.unsafePerformIO is deprecated
Simon Marlow <marlowsd at gmail.com>**20100720082804
 Ignore-this: 4cfebb8f2a1cddc7d15e94e31b2befa4
 We can't actually deprecate it without introducing a name clash
 between Foreign.unsafePerformIO and System.IO.Unsafe.unsafePerformIO
] 
[doc formatting fix
Simon Marlow <marlowsd at gmail.com>**20100714151347
 Ignore-this: 255edef607dcd290e198015240b5d125
] 
[add module intro from Haskell 2010
Simon Marlow <marlowsd at gmail.com>**20100714115853
 Ignore-this: 59b5a07507a059ccccdff2dfb6490a27
] 
[document exception-overriding behaviour in withFile
Simon Marlow <marlowsd at gmail.com>**20100714104107
 Ignore-this: f99e641ea2f46d872cb7420a62fa50dc
] 
[doc: use "finalizer" consistently
Simon Marlow <marlowsd at gmail.com>**20100714103649
 Ignore-this: bdfea40f31dc5045fdbc6e12266dda93
] 
[clarify meaning of bit
Simon Marlow <marlowsd at gmail.com>**20100714103310
 Ignore-this: 521b031f1e83ef34ca03d9aa9273df8a
] 
[note shortcutting behaviour of any/all/elem
Simon Marlow <marlowsd at gmail.com>**20100714103304
 Ignore-this: 1605f362ba0712ad1cea1309636f3ea1
] 
[add cast{C,U}CharToChar and castCharTo{C,U}Char, from Haskell 2010
Simon Marlow <marlowsd at gmail.com>**20100713132515
 Ignore-this: 9b1da827016c7b08668078b45964e9de
] 
[mention that IntPtr and WordPtr can be marshalled to/from intptr_t and uintptr_t
Simon Marlow <marlowsd at gmail.com>**20100713132403
 Ignore-this: dcc112a72746ba117a84fa29e71b6800
] 
[Partial fix for Trac #4136
simonpj at microsoft.com**20100707135725
 Ignore-this: 9548eeb3187d9779d4e5c858a0f35354
 
 In 'choose' (which is a library function designed specifically
 to support derived instances of Read), we must match Symbol
 as well as Ident, for nullary constructors that (wierdly) are
 symbols.
] 
[Fix typo in documentation
Simon Hengel <simon.hengel at wiktory.org>**20100711141648
 Ignore-this: c052dd8a681832ef598a323ad55eae3a
] 
[Remove duplicated word in documentation
Simon Hengel <simon.hengel at wiktory.org>**20100711072703
 Ignore-this: fb3732dc57be55f14168792f923433
] 
[Allow nhc98 to cope with recent changes to Control.Exception.
Malcolm.Wallace at me.com**20100710170940] 
[ New asynchronous exception control API (base parts)
Simon Marlow <marlowsd at gmail.com>**20100708152735
 Ignore-this: 71a4811804f04259f1fe739f8863beaf
   
 As discussed on the libraries/haskell-cafe mailing lists
   http://www.haskell.org/pipermail/libraries/2010-April/013420.html
 
 This is a replacement for block/unblock in the asychronous exceptions
 API to fix a problem whereby a function could unblock asynchronous
 exceptions even if called within a blocked context.
 
 The new terminology is "mask" rather than "block" (to avoid confusion
 due to overloaded meanings of the latter).
 
 The following is the new API; the old API is deprecated but still
 available for the time being.
 
 Control.Exception
 -----------------
 
 mask  :: ((forall a. IO a -> IO a) -> IO b) -> IO b
 mask_ :: IO a -> IO a
 
 uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
 uninterruptibleMask_ :: IO a -> IO 
 
 getMaskingState :: IO MaskingState
 
 data MaskingState
   = Unmasked
   | MaskedInterruptible 
   | MaskedUninterruptible
 
 
 Control.Concurrent
 ------------------
 
 forkIOUnmasked :: IO () -> IO ThreadId
] 
[Async-exception safety, and avoid space leaks
Simon Marlow <marlowsd at gmail.com>**20100708145819
 Ignore-this: dbfd0e61551e9e7b4fc1c6fe9b9a83de
 Patch submitted by: Bas van Dijk <v.dijk.bas at gmail.com>
 Modified slightly by me to remove non-functional changes.
] 
[Async-exception safety, and avoid space leaks
Simon Marlow <marlowsd at gmail.com>**20100708103154
 Ignore-this: 190c3ac8f6633231624da8cf1316588
 Patch submitted by: Bas van Dijk <v.dijk.bas at gmail.com>
 Modified slightly by me to remove non-functional changes.
] 
[Fix a few places where we forgot to close the text codecs (#4029)
Simon Marlow <marlowsd at gmail.com>**20100702130210
 Ignore-this: 2e81a4b4cb343181cef34b0f9e2ded47
 Each time you invoke :load in GHCi it resets the CAFs, including
 stdin/stdout/stderr, and each of these was allocating a new iconv_t.
] 
[remove docs from Monad that belonged on the instance for MonadPlus IO
Simon Marlow <marlowsd at gmail.com>**20100701154203
 Ignore-this: 59df02542a7ac9421552a2155d848d27
] 
[docs: unqualify Prelude.IO
Simon Marlow <marlowsd at gmail.com>**20100701153817
 Ignore-this: 73b0202876c827e7a5b4a5ce74e724c4
] 
[unqualify Float and Double
Simon Marlow <marlowsd at gmail.com>**20100701142727
 Ignore-this: cbe89d31a00bf49996a33933324fca17
] 
[extract information about Data.Time from docs for CTime
Simon Marlow <marlowsd at gmail.com>**20100701142415
 Ignore-this: c48c9609b8d36e43e033a7bea81d6f17
] 
[doc typo
Simon Marlow <marlowsd at gmail.com>**20100701142354
 Ignore-this: 17a1fd703831c888975ff63fbfa3a9b2
] 
[peekArray docs: remove mentions of "this version" and "previous version"
Simon Marlow <marlowsd at gmail.com>**20100701125333
 Ignore-this: 39a744874258670bd935ba9e38390939
] 
[doc typo
Simon Marlow <marlowsd at gmail.com>**20100701124154
 Ignore-this: 98f5c286e38c2c34c96b05d5e8bc5ad9
] 
[doc typo
Simon Marlow <marlowsd at gmail.com>**20100701124128
 Ignore-this: 10a4314ec7aed336701fc616fb574ebc
] 
[doc typo
Simon Marlow <marlowsd at gmail.com>**20100701123715
 Ignore-this: c4909a7bf7163460ee5d32f58812041e
] 
[doc wibble: Haskell 98 I/O Error -> 'IOError'
Simon Marlow <marlowsd at gmail.com>**20100701123612
 Ignore-this: bf373df781acbc575e4ffe3b7e6059ae
] 
[doc typo
Simon Marlow <marlowsd at gmail.com>**20100701123014
 Ignore-this: 16aaccae48ef3101adf78ea5b0d5a8fd
] 
[Haddock hacks to fix whitespace consistency
Simon Marlow <marlowsd at gmail.com>**20100701121631
 Ignore-this: 61c58dec52a31fd2d3f331a87d2f903f
] 
[use '==' consistently rather than '->' in examples
Simon Marlow <marlowsd at gmail.com>**20100701121616
 Ignore-this: 472b0a05a85d34d9712186040e1636d9
] 
[doc wibble: remove confusing mention of "Prelude"
Simon Marlow <marlowsd at gmail.com>**20100701113308
 Ignore-this: 232283d0096d01cd45e9b3c5c1e63a6d
] 
[doc wibble: nonstrict -> non-strict
Simon Marlow <marlowsd at gmail.com>**20100701113253
 Ignore-this: 4264f0ab23a0835fc13c6e8601d6b743
] 
[doc whitespace
Simon Marlow <marlowsd at gmail.com>**20100701112242
 Ignore-this: 777a95b1d1140c61d3ab95d5eb5809e7
] 
[move the doc for 'Char' to its new home in ghc-prim:GHC.Types
Simon Marlow <marlowsd at gmail.com>**20100629134150
 Ignore-this: 7687db0077a29498349bfb4b44983985
] 
[doc wibble
Simon Marlow <marlowsd at gmail.com>**20100629122608
 Ignore-this: 9a909e5d015332dc445bd9592e6e386d
] 
[doc updates in System.IO
Simon Marlow <marlowsd at gmail.com>**20100629122118
 Ignore-this: 2257ec1cc4cdb8b7804cfa1f3cf32753
] 
[doc wibble
Simon Marlow <marlowsd at gmail.com>**20100625134858
 Ignore-this: 64c50f29df6c389273b818918fe7033a
] 
[doc wibbles
Simon Marlow <marlowsd at gmail.com>**20100624154614
 Ignore-this: b364aad53beea6e741fee2824459b6e8
] 
[Fix haddock formatting
Ian Lynagh <igloo at earth.li>**20100625222623] 
[Give nub's complexity in the haddock docs; fixes #4086
Ian Lynagh <igloo at earth.li>**20100625222059] 
[correct docs for exitWith: only stdout/stderr are flushed, not all Handles
Simon Marlow <marlowsd at gmail.com>**20100624130506
 Ignore-this: 33a938dad8f0bc061572e2ec571cacc7
] 
[fix docs for isSpace
Simon Marlow <marlowsd at gmail.com>**20100624130444
 Ignore-this: b35ff080dbb9833176f08e39dbd9ff6d
] 
[make the hGetBuf/hPutBuf family work with non-FD Handles (#4144)
Simon Marlow <marlowsd at gmail.com>**20100624130425
 Ignore-this: 8200f0208a9b1b1cf4824f343d75819a
] 
[nit in docs for accumArray
Simon Marlow <marlowsd at gmail.com>**20100622121131
 Ignore-this: c066a456c40907e767df10c3990f35ff
] 
[add doc for the ExitCode type
Simon Marlow <marlowsd at gmail.com>**20100622120930
 Ignore-this: 99c34332be7f3565da844528b470054a
] 
[remove extraneous info from docs for Array
Simon Marlow <marlowsd at gmail.com>**20100622120921
 Ignore-this: e2a3f5e84fc23eb7bae911f0680e805e
] 
[add an INLINE to the list version of traverse, to enable fusion
Simon Marlow <marlowsd at gmail.com>**20100608082531
 Ignore-this: ea98cdc3308b406bb04c0f7a38c4424b
] 
[Don't define the C localeEncoding on Windows
Ian Lynagh <igloo at earth.li>**20100620202342
 Ignore-this: c4992f6832a391b0cccc5a9b7d643976
 (it causes warnings, and isn't used)
] 
[add Applicative instance for Either (proposal #4095)
Ross Paterson <ross at soi.city.ac.uk>**20100617225110
 Ignore-this: 50262ec4700dc16efec5755be5b308c5
 
 This is not the only possible instance for Either, but this one is
 compatible with the usual Monad instance.
] 
[Use libcharset instead of nl_langinfo(CODESET) if possible.
pho at cielonegro.org**20100519013112
 Ignore-this: 4c1e278e022a3d276848afc1dcba4425
 
 nl_langinfo(CODESET) doesn't always return standardized variations of the encoding names. Use libcharset if possible, which is shipped together with GNU libiconv.
] 
[Add a note about the interruptibility of throwTo.
Simon Marlow <marlowsd at gmail.com>**20100615112720
 Ignore-this: ae9fabe95310d7c364e95f7784793485
] 
[docs: note that hGetBufNonBlocking isn't non-blocking on Windows
Simon Marlow <marlowsd at gmail.com>**20100615112547
 Ignore-this: 4f3e5213e142149affe08c5123d6efea
] 
[don't depend on Prelude (#4122)
Simon Marlow <marlowsd at gmail.com>**20100615105631
 Ignore-this: 1a3fd49b103fe31cbb453f302c18767f
] 
[Don't depend on Prelude (#4123)
Simon Marlow <marlowsd at gmail.com>**20100615105401
 Ignore-this: cc7616d85a1637bc7621b4f2bc181c0e
] 
[bump version to 4.3.0.0, added instance MonadPlus STM
Simon Marlow <marlowsd at gmail.com>**20100601144831
 Ignore-this: 7c3cf7574499c4267372493f2636dc0
] 
[Moved MonadPlus instance for STM from Control.Monad.STM to GHC.Conc to avoid an orphaned instance
Bas van Dijk <v.dijk.bas at gmail.com>**20100516160651
 Ignore-this: 651b852942b2fae2b93f996e39239b8f
] 
[Added Applicative and Alternative instances for STM
Bas van Dijk <v.dijk.bas at gmail.com>**20100516171756
 Ignore-this: 567003bc4040bc97105cda4d31ebf04a
] 
[expand Foldable instance for Array
Ross Paterson <ross at soi.city.ac.uk>**20100602212154
 Ignore-this: 9bd9e9666a9400431eb92352244fe7e7
] 
[doc comment illustrating Foldable(foldr)
Ross Paterson <ross at soi.city.ac.uk>**20100527150833
 Ignore-this: 8f27d889379803f3ba86d6e928428f3c
] 
[fix syntax in doc comments
Ross Paterson <ross at soi.city.ac.uk>**20100527150757
 Ignore-this: cb78da51d60ff6863dc395f1a892c103
] 
[export hGetBufSome (#4046)
Simon Marlow <marlowsd at gmail.com>**20100520093538
 Ignore-this: f467fad9722e27edfad6b3dd75290e7b
] 
[hWaitForInput: don't try to read from the device (#4078)
Simon Marlow <marlowsd at gmail.com>**20100517133741
 Ignore-this: 55ec33b03397380259b91e4ca62207a6
 readTextDeviceNonBlocking is not non-blocking on Windows
] 
[hSetEncoding: change the encoding on both read and write sides (#4066)
Simon Marlow <marlowsd at gmail.com>**20100514124628
 Ignore-this: 5b9e9caef06356d0296c584159709ebb
] 
[Correct haddock formatting.
Adam Vogt <vogt.adam at gmail.com>**20100423022103
 Ignore-this: d2622339302048fda48080f7d5ce4a2f
] 
[Fix for hGetBufSome
Simon Marlow <marlowsd at gmail.com>**20100505135637
 Ignore-this: 2019680f8fb223956cacfcf0d046f133
] 
[improve the documentation for throwTo and killThread (#3884)
Simon Marlow <marlowsd at gmail.com>**20100505135600
 Ignore-this: ce881d96ddb729acb6ca09c779975e7d
] 
[elaborate the docs for unsafePerformIO a bit
Simon Marlow <marlowsd at gmail.com>**20100505101249
 Ignore-this: 1cec3f67560b672c64c5a0dcf9a79eb7
] 
[add Typeable instance
Simon Marlow <marlowsd at gmail.com>**20100504152815
 Ignore-this: 6d9cf9d62f0ef17fa459bf213a04098
] 
[Add hGetBufSome, like hGetBuf but can return short reads
Simon Marlow <marlowsd at gmail.com>**20100504152759
 Ignore-this: 195c905b43f8d9505029364e2c5b18e
] 
[Add swap (#3298)
Simon Marlow <marlowsd at gmail.com>**20100504095339
 Ignore-this: 13b007dc4594ce252997ec6fa0bbd976
] 
[inline allocaArray0, to fix withCString benchmark
Simon Marlow <marlowsd at gmail.com>**20100423124729
 Ignore-this: 35c96816acc2f3aaf9dd29f7995fa6f0
] 
[raise asynchronous exceptions asynchronously (#3997)
Simon Marlow <marlowsd at gmail.com>**20100421094932
 Ignore-this: 6d987d93d382c0f69c68c326312abd6b
] 
[add NOINLINE pragmas for stdin/stdout/stderr
Simon Marlow <marlowsd at gmail.com>**20100421082041
 Ignore-this: 3fc130268ec786f28d945858d6690986
] 
[INLINE alloca and malloc
Simon Marlow <marlowsd at gmail.com>**20100419135333
 Ignore-this: b218bd611f18721b1505a8c0b9e6a16a
 See discussion on glasgow-haskell-users:
   http://www.haskell.org/pipermail/glasgow-haskell-users/2010-April/018740.html
] 
[Move comment closer to the offending line
Matthias Kilian <kili at outback.escape.de>**20100419155421
 Ignore-this: b34a1d7affd66f67d210df2377b585d9
] 
[Ignore the return code of c_fcntl_write again
Matthias Kilian <kili at outback.escape.de>**20100415140452
 Ignore-this: 266d8ba02cc3cb79c85629b3528261c9
 
 The return code has been ignored in the past on purpose, because
 O_NONBLOCK will fail on BSDs for some special files. This fixes the
 problem mentioned in
 http://www.haskell.org/pipermail/glasgow-haskell-users/2010-April/018698.html
 
] 
[Fix bitrot in IO debugging code
Ian Lynagh <igloo at earth.li>**20100413134339
 Also switched to using Haskell Bools (rather than CPP) to en/disable it,
 so it shouldn't break again in the future.
] 
[Tiny code tidy-up
Ian Lynagh <igloo at earth.li>**20100413011147] 
[remove old/wrong comment
Simon Marlow <marlowsd at gmail.com>**20100325161403
 Ignore-this: e6e377d44af48c4162d17d55bdf3f821
] 
[withThread: block asynchronous exceptions before installing exception handler.
Bas van Dijk <v.dijk.bas at gmail.com>**20100329131624
 Ignore-this: be5aeb47dbd73807b5f94df11afbb81c
 Note that I don't unblock the given io computation. Because AFAICS
 withThread is only called with 'waitFd' which only performs an FFI
 call which can't receive asynchronous exceptions anyway.
] 
[runInUnboundThread: block asynchronous exceptions before installing exception handler
Bas van Dijk <v.dijk.bas at gmail.com>**20100329131549
 Ignore-this: a00c5e32fe3981ff87bedd367a69051e
] 
[fix the deprecation message (GHC.IO.Handle.Base -> GHC.IO.Handle)
Simon Marlow <marlowsd at gmail.com>**20100330121137
 Ignore-this: 4ca8500a01ac93454507aa8f9dd001f9
] 
[Make SampleVar an abstract newtype
Bas van Dijk <v.dijk.bas at gmail.com>**20100318200349
 Ignore-this: 27939e2a064b75e71cb146117346be30
] 
[Fix bugs regarding asynchronous exceptions and laziness in Control.Concurrent.SampleVar
Bas van Dijk <v.dijk.bas at gmail.com>**20100318200104
 Ignore-this: 7376b2a3afe155daf233a8f1ddc0a7a
  - Block asynchronous exceptions at the right places
  - Force thunks before putting them in a MVar
] 
[Write the thunk 'next' to the MVar
Bas van Dijk <v.dijk.bas at gmail.com>**20100319125951
 Ignore-this: dd25636cf220131385ff2fd32493d456
] 
[change to use STM, fixing 4 things
Simon Marlow <marlowsd at gmail.com>**20100318104436
 Ignore-this: 551d30280a7941c08f5c3b14576bdd70
   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.
] 
[Tweak docs
Ian Lynagh <igloo at earth.li>**20100312214129] 
[Fixed dead links in documentation of forkIO
Bas van Dijk <v.dijk.bas at gmail.com>**20100308222415
 Ignore-this: 7deb8fd064c867fbede2a6b2e9da4f15
] 
[Documentation fixes in Control.Exception
Bas van Dijk <v.dijk.bas at gmail.com>**20100301220442
 Ignore-this: 761fcba401cbd1f47276ddfc9b5b80f2
] 
[Plug two race conditions that could lead to deadlocks in the IO manager
Simon Marlow <marlowsd at gmail.com>**20100225120255
 Ignore-this: e6983d6b953104d370278ab3e4617e8b
] 
[FIX #3866: improve documentation of Data.Data.Constr
jpm at cs.uu.nl**20100224125506
 Ignore-this: 3818c5d8fee012a3cf322fb455b6e5dc
] 
[UNDO: Handle NaN, -Infinity and Infinity in the toRational for Float/Double (#3676)
Simon Marlow <marlowsd at gmail.com>**20100223101603
 Ignore-this: 78becb2d39b3cd9a1a473a5811ca7d92
] 
[Put the complexity in the length docs. Fixes trac #3680
Ian Lynagh <igloo at earth.li>**20100221191425] 
[nhc98 should build Data.Functor.
Malcolm.Wallace at cs.york.ac.uk**20100221163218] 
[Update the exitWith docs
Ian Lynagh <igloo at earth.li>**20100213140004
 Error pointed out by Volker Wysk <vw at volker-wysk.de>
] 
[Handle NaN, -Infinity and Infinity in the toRational for Float/Double (#3676)
Simon Marlow <marlowsd at gmail.com>**20100211101955
 Ignore-this: 261415363303efca265e80290eac5f28
] 
[For nhc98, import unsafeInterleaveIO rather than defining it here.
Malcolm.Wallace at cs.york.ac.uk**20100204171021] 
[Stifle warning about unused return value
benl at cse.unsw.edu.au**20100203025537] 
[fix #3832: use the locale encoding in openTempFile
Simon Marlow <marlowsd at gmail.com>**20100120211830
 Ignore-this: df4f778cc5fefb32290c798db722632c
 Also while I was here fix an XXX: the Handle contained an
 uninformative string like <fd: 4> for error messages rather than the
 real file path.
] 
[Fix the build: export void, so it doesn't give an unused binding warning
Ian Lynagh <igloo at earth.li>**20100116174451] 
[hIsEOF: don't do any decoding (#3808)
Simon Marlow <marlowsd at gmail.com>**20100112230317
 Ignore-this: 6a384dd2d547ffe3ad3762920e5c1671
] 
[Control.Monad: +void :: f a -> f ()
gwern0 at gmail.com**20100108214455
 Ignore-this: 4dc07452315f2d1b4941903ff42fc45f
 See http://hackage.haskell.org/trac/ghc/ticket/3292
 Turns m a -> m (). Lets one call functions for their side-effects without
 having to get rid of their return values with '>> return ()'. Very useful
 in many contexts (parsing, IO etc.); particularly good for 'forkIO' and 'forM_',
 as they demand return types of 'IO ()' though most interesting IO functions
 return non-().
] 
[Replace the implementation of mergesort with a 2x faster one.
Malcolm.Wallace at cs.york.ac.uk**20091224152014
 See ticket http://hackage.haskell.org/trac/ghc/ticket/2143.
] 
[Restore previous Data.Typeable.typeOf*Default implementations for non-ghc.
Malcolm.Wallace at cs.york.ac.uk**20091223142625
 Not all compilers have ScopedTypeVariables.
] 
[Add comments about double bounds-checking, and fast paths for rectangular arrays
simonpj at microsoft.com**20091218165655
 Ignore-this: ea0849419dc00927aba4bd410b1cc58d
 
 See Note [Double bounds-checking of index values] for the details.
 
 The fast paths omit the doubled checks for cases we know about
] 
[Fix Trac #3245: memoising typeOf
simonpj at microsoft.com**20091218155117
 Ignore-this: 5a178a7f2222293c5ee0c3c43bd1b625
 
 The performance bug in #3245 was caused by computing the typeRep
 once for each call of typeOf, rather than once for each dictionary
 contruction.  (Computing TypeReps is reasonably expensive, because
 of the hash-consing machinery.)
 
 This is readily fixed by putting the TypeRep construction outside
 the lambda.  (Arguably GHC might have worked that out itself,
 but it involves floating something between a type lambda and a
 value lambda, which GHC doesn't currently do. If it happens a lot
 we could fix that.)
] 
[Mark 'index' as INLINE in GHC.Arr
simonpj at microsoft.com**20091216170441
 Ignore-this: a4df9d8acf496c8e0e9ce5a520509a2a
 
 This makes indexing much faster. See Trac #1216
] 
[Comment the remaining orphan instance modules
Ian Lynagh <igloo at earth.li>**20091206125021] 
[De-orphan Eq/Ord Float/Double
Ian Lynagh <igloo at earth.li>**20091205181238] 
[Add comments to "OPTIONS_GHC -fno-warn-orphans" pragmas
Ian Lynagh <igloo at earth.li>**20091205165854] 
[Data.Either.partitionEithers was insufficiently lazy.
Malcolm.Wallace at cs.york.ac.uk**20091202032807
 Ignore-this: 77e1b3288f66608c71458d8a91bcbe12
 Spotted by Daniel Fischer.
] 
[fix the docs regarding finalizer guarantees
Simon Marlow <marlowsd at gmail.com>**20091130144409
 Ignore-this: d1ab9532c74a002b8075ff60febcbe2d
] 
[x86_64 requires more stack
Malcolm.Wallace at cs.york.ac.uk**20091201033745] 
[check for size < 0 in mallocForeignPtrBytes and friends (#3514)
Simon Marlow <marlowsd at gmail.com>**20091125143822
 Ignore-this: 91077d01da2bbe1dfed5155e8b40da9
] 
[hGetContents: close the handle properly on error
Simon Marlow <marlowsd at gmail.com>**20091125123435
 Ignore-this: bc37ff678acc6e547dc390285e056eb9
 
 When hGetContents caught an error it was closing the handle and then
 throwing the exception, without updating the handle with the new
 closed state.  This lead to a double-closed, which was the cause of
 
 *** glibc detected *** ./Setup: double free or corruption 
 
 when iconv_close was called twice on the decoder.
 
 See http://hackage.haskell.org/trac/hackage/ticket/609
] 
[Fix arities of mapFB and zipFB
Roman Leshchinskiy <rl at cse.unsw.edu.au>**20091126232219
 Ignore-this: c4e14cd0a92622549c86e67237a40865
] 
[Remove an unnecessary -fno-warn-orphans flag
Ian Lynagh <igloo at earth.li>**20091126123404] 
[Tweak layout to work with alternative layout rule
Ian Lynagh <igloo at earth.li>**20091125232349] 
[Tweak layout to be accepted by the alternative layout rul
Ian Lynagh <igloo at earth.li>**20091125194147] 
[Make sure zipWithFB has arity 2
Roman Leshchinskiy <rl at cse.unsw.edu.au>**20091125010003
 Ignore-this: 4cf60c55666f03d22a9f5a6e07f52d36
 
 It gets 2 arguments in the "zipWith" rule but its arity was higher and the new
 inliner didn't inline it sometimes, for instance here:
 
 mpp ::  [Double] -> [Double] -> [Double] -> [Double] -> [Double]
 mpp as bs cs ds = zipWith (*) (zipWith (+) as bs) (zipWith (+) cs ds)
  
 This was a regression vs. 6.10.
] 
[Remove an old comment
Ian Lynagh <igloo at earth.li>**20091124134647] 
[De-orphan the Eq/Ord Integer instances
Ian Lynagh <igloo at earth.li>**20091124133639] 
[Whitespace only
Ian Lynagh <igloo at earth.li>**20091124133421] 
[Derive some more instances, rather than writing them by hand
Ian Lynagh <igloo at earth.li>**20091124011747] 
[We can now derive Ord ()
Ian Lynagh <igloo at earth.li>**20091124011416] 
[De-orphan tuple Eq/Ord instances
Ian Lynagh <igloo at earth.li>**20091123233343] 
[Control.Exception.Base no longer has any orphans
Ian Lynagh <igloo at earth.li>**20091123224905] 
[De-orphan the MonadFix ST instance for GHC
Ian Lynagh <igloo at earth.li>**20091123223544] 
[Rearrange the contents of Control.Monad.ST; no functionality changes
Ian Lynagh <igloo at earth.li>**20091123222702] 
[De-orphan the Eq/Ord [a] instances
Ian Lynagh <igloo at earth.li>**20091123215635] 
[De-orphan the Eq/Ord Char instances
Ian Lynagh <igloo at earth.li>**20091123202253] 
[De-orphan the Eq/Ord Bool instances
Ian Lynagh <igloo at earth.li>**20091123201817] 
[Move Eq/Ord Ordering instances to de-orphan them
Ian Lynagh <igloo at earth.li>**20091123194310] 
[Remove ffi warnings for nhc98.
Malcolm.Wallace at cs.york.ac.uk**20091123063743] 
[Second attempt to fix #1185 (forkProcess and -threaded)
Simon Marlow <marlowsd at gmail.com>**20091111151915
 Ignore-this: fa5f5d5e4e080d4b612a37244f937f9c
 
 Patch 2/2: first patch is to ghc
 
 This time without dynamic linker hacks, instead I've expanded the
 existing rts/Globals.c to cache more CAFs, specifically those in
 GHC.Conc.  We were already using this trick for signal handlers, I
 should have realised before.
 
 It's still quite unsavoury, but we can do away with rts/Globals.c in
 the future when we switch to a dynamically-linked GHCi.
] 
[Rollback #1185 fix
Simon Marlow <marlowsd at gmail.com>**20091106140629
 Ignore-this: cd5667e8474e37e01ba26a1984274811
 
 rolling back:
 
 Tue Nov  3 16:05:40 GMT 2009  Simon Marlow <marlowsd at gmail.com>
   * Fix #1185: restart the IO manager after fork()
   
   This is the libraries/base part of the patch; there is a corresponding
   patch to GHC itself.
   
   The main change is that we now keep track of the IO manager's ThreadId
   in a top-level MVar, and ensureIOManagerIsRunning checks whether a
   previous IO manager thread is alive before starting one.  In the child
   of fork(), we can hence call ensureIOManagerIsRunning to restart the
   IO manager.
 
     M ./GHC/Conc.lhs -46 +44
 
 Wed Nov  4 17:49:45 GMT 2009  Ian Lynagh <igloo at earth.li>
   * Fix the build on Windows
 
     M ./GHC/Conc.lhs -6 +4
] 
[Fix the build on Windows
Ian Lynagh <igloo at earth.li>**20091104174945] 
[Fix #1185: restart the IO manager after fork()
Simon Marlow <marlowsd at gmail.com>**20091103160540
 Ignore-this: 6dc05464f1500104554637f4759738cc
 
 This is the libraries/base part of the patch; there is a corresponding
 patch to GHC itself.
 
 The main change is that we now keep track of the IO manager's ThreadId
 in a top-level MVar, and ensureIOManagerIsRunning checks whether a
 previous IO manager thread is alive before starting one.  In the child
 of fork(), we can hence call ensureIOManagerIsRunning to restart the
 IO manager.
] 
[improve the documentation for throwErrnoIfRetry
Simon Marlow <marlowsd at gmail.com>**20091016112404
 Ignore-this: b77275cacf730e15757946027168f63e
] 
[Don't inline unpackFoldrCString ever
simonpj at microsoft.com**20091029135350
 Ignore-this: 85d672649b1b776efc7e97500b05d4f9
] 
[Inline more default methods
simonpj at microsoft.com**20091029135330
 Ignore-this: 289c44b0afd6d5631c2a4e0664275ca9
 
 Namely Monad: (>>)
        Eq:    (==), (/=)
        Num:   (-), negate
        Real:  quot, rem, div, mod, recip, (/), truncate
        Float: (**), logBase, sqrt, tan, tanh
] 
[Move error messages out of INLINEd default methods
simonpj at microsoft.com**20091029135118
 Ignore-this: 9e35dc947f94827a3529eb53a41575fd
 
 No need to duplicate the error generation!
] 
[Exploit now-working default-method INLINE pragmas for Data.Bits
simonpj at microsoft.com**20091029135041
 Ignore-this: 8adf225f31ca7a3181ee087e9e4fe535
 
 * Add INLINE pragmas to default methods for class Bits
 
 * Remove redundant instance methods elsewhere, now that
   the default method will do the job
] 
[Tidy up and comment imports
simonpj at microsoft.com**20091029134414
 Ignore-this: bf2be31035de975d8995e988933cc940
] 
[Inline foldr and (.) when applied to two arguments not three
simonpj at microsoft.com**20091029134335
 Ignore-this: fccb6f3e90e15f44cb465814be85ede2
 
 The new INLINE story is (by design) arity-sensitive, so we must
 put fewer argument on the LHS for foldr and (.)
] 
[dirUtils.c no longer available
Malcolm.Wallace at cs.york.ac.uk**20091013093833] 
[Make hGetContents throw an exception if an error is encountered
Simon Marlow <marlowsd at gmail.com>**20091012152955
 Ignore-this: 9f7a7176193eab25c9daaacd9261f2de
 
 Strictly speaking this breaks Haskell 98 compatibility, which requires
 hGetContents to just end the lazy stream silently if an error is
 encountered.  However, for a few reasons we think it will make
 everyone's life a bit easier if we make this change
 
  1. Errors will be a lot more common in GHC 6.12.1, in the form
     of Unicode decoding errors.
 
  2. When Haskell 98 was designed, we didn't know how to throw
     exceptions from inside lazy I/O, but now we do.
 
  3. If anyone is actually relying on the previous behaviour, their
     code is arguably broken.
] 
[Re-instate System.Console.Getopt for nhc98 builds.
Malcolm.Wallace at cs.york.ac.uk**20091013092843
 Although it was split out of base a while back, that change was
 reverted for ghc soon afterwards, but nhc98 never noticed.
] 
[Roll back "Another instance of nhc98's strange import semantics."
Ian Lynagh <igloo at earth.li>**20091009185618
 Fri Oct  9 14:50:51 BST 2009  Malcolm.Wallace at cs.york.ac.uk
 GHC (correctly) warns about the unused import, which breaks the validate
 build.
] 
[Roll back "Cope with nhc98's (occasionally-strange) import semantics"
Ian Lynagh <igloo at earth.li>**20091009184704
 Fri Oct  9 14:43:51 BST 2009  Malcolm.Wallace at cs.york.ac.uk
 GHC (correctly) warns about the unused import, which breaks the validate
 build.
] 
[It seems that nhc98 needs defaulting in Data.Fixed.
Malcolm.Wallace at cs.york.ac.uk**20091009135242] 
[Another instance of nhc98's strange import semantics.
Malcolm.Wallace at cs.york.ac.uk**20091009135051] 
[Make Data.Functor compatible with non-GHC compilers.
Malcolm.Wallace at cs.york.ac.uk**20091009134821] 
[Cope with nhc98's (occasionally-strange) import semantics.
Malcolm.Wallace at cs.york.ac.uk**20091009134351] 
[Fix gratuitous breakage of nhc98 in System.IO.
Malcolm.Wallace at cs.york.ac.uk**20091009134001] 
[Fix gratuitous breakage of nhc98 in Control.Exception.Base.
Malcolm.Wallace at cs.york.ac.uk**20091009133615] 
[Fix gratuitous breakage of non-GHC in Data.Fixed.
Malcolm.Wallace at cs.york.ac.uk**20091009133330] 
[Fix gratuitous breakage for non-GHC in Data.Bits.
Malcolm.Wallace at cs.york.ac.uk**20091009133257] 
[Use UTF-32LE instead of UTF32LE
Simon Marlow <marlowsd at gmail.com>**20091006100207
 Ignore-this: 7f881e36543d250ef848c9f60d67655a
 The latter is not recognised by some iconv implementations.
] 
[Strip any Byte Order Mark (BOM) from the front of decoded streams.
Ben.Lippmeier at anu.edu.au*-20090930084229
 Ignore-this: d0d0c3ae87b31d71ef1627c8e1786445
 When decoding to UTF-32, Solaris iconv inserts a BOM at the front
 of the stream, but Linux iconv doesn't. 
] 
[use UTF32BE/UTF32LE instead of UCS-4/UCS-4LE
Simon Marlow <marlowsd at gmail.com>**20091005101554
 Ignore-this: 2aef5e9bec421e714953b7aa1bdfc1b3
] 
[Strip any Byte Order Mark (BOM) from the front of decoded streams.
Ben.Lippmeier at anu.edu.au**20090930084229
 Ignore-this: d0d0c3ae87b31d71ef1627c8e1786445
 When decoding to UTF-32, Solaris iconv inserts a BOM at the front
 of the stream, but Linux iconv doesn't. 
] 
[Add traceEvent :: String -> IO ()
Simon Marlow <marlowsd at gmail.com>**20090925141257
 Ignore-this: 8b1888bbf9682ffba13f815b6000e4b1
 For emitting an event via the RTS tracing framework
] 
[Fix the error message when flushing the read buffer of a non-seekable Handle
Simon Marlow <marlowsd at gmail.com>**20090923090536
 Ignore-this: 4342026df93759d99480f4e13f80a492
] 
[Fix #3534: No need to flush the byte buffer when setting binary mode
Simon Marlow <marlowsd at gmail.com>**20090923090445
 Ignore-this: 625817ed7ae2c12291eb993a99dc640a
] 
[Use let !y = x in .. x .. instead of seq in $! and evaluate (#2273)
Simon Marlow <marlowsd at gmail.com>**20090916140454] 
[make some Applicative functions into methods, and split off Data.Functor (proposal #3335)
Ross Paterson <ross at soi.city.ac.uk>**20090915173109
 Ignore-this: a0cff4de6dfdbcbd56a66101bc4855a9
 
 The following functions
 
     (<$) :: Functor f => a -> f b -> f a
     (*>) :: Applicative f => f a -> f b -> f b
     (<*) :: Applicative f => f a -> f b -> f a
     some :: Alternative f => f a -> f [a]
     many :: Alternative f => f a -> f [a]
 
 are moved into the corresponding classes, with the existing implementations
 as default definitions.  This gives people creating instances the option of
 defining specialized implementations of these functions, though they should
 be equivalent to the default definitions.
 
 Although (<$) is now a method of the Functor class, it is hidden in the
 re-export by the Prelude, Control.Monad and Monad.  The new module
 Data.Functor exposes the full class, plus the function (<$>).  These are
 also re-exported by Control.Applicative.
] 
[On Windows, use the console code page for text file encoding/decoding.
Judah Jacobson <judah.jacobson at gmail.com>**20090913022126
 Ignore-this: 86c2f2db8ef92b751599795d3195187b
 
 We keep all of the code page tables in the module
 GHC.IO.Encoding.CodePage.Table.  That file was generated automatically
 by running codepages/MakeTable.hs; more details are in the comments at the
 start of that script.
 
 Storing the lookup tables adds about 40KB to each statically linked executable;
 this only increases the size of a "hello world" program by about 7%.
 
 Currently we do not support double-byte encodings (Chinese/Japanese/Korean), since
 including those codepages would increase the table size to 400KB.  It will be
 straightforward to implement them once the work on library DLLs is finished.
] 
[Fix "init" docs: the input list need not be finite. Fixes trac #3465
Ian Lynagh <igloo at earth.li>**20090911210437] 
[Bump base version to 4.2.0.0
Ian Lynagh <igloo at earth.li>**20090911153913] 
[Address #3310
Simon Marlow <marlowsd at gmail.com>**20090830152850
 Ignore-this: 40c7f7c171ee299a83092fd360a952b7
 
  - Rename BlockedOnDeadMVar   -> BlockedIndefinitelyOnMVar
  - Rename BlockedIndefinitely -> BlockedIndefinitelyOnSTM
  - instance Show BlockedIndefinitelyOnMVar is now
      "blocked indefinitely in an MVar operation"
  - instance Show BlockedIndefinitelyOnSTM is now
      "blocked indefinitely in an STM transaction"
 
 clients using Control.OldException will be unaffected (the new
 exceptions are mapped to the old names).  However, for base4-compat
 we'll need to make a version of catch/try that does a similar
 mapping.
] 
[Fix unicode conversion for MSB architectures
Ben.Lippmeier at anu.edu.au**20090830130028
 This fixes the SPARC/Solaris build.
] 
[Fix #3441: detect errors in partial sequences
Simon Marlow <marlowsd at gmail.com>**20090830075909
 Ignore-this: d12a75d95e0cae5eb1555266810ec281
] 
[Fix hWaitForInput
Simon Marlow <marlowsd at gmail.com>**20090827152116
 Ignore-this: 2550e911f1a4d4357a5aa8d1764238ce
 It was erroneously waiting when there were bytes to decode waiting in
 the byte buffer.
] 
[fix debugging code
Simon Marlow <marlowsd at gmail.com>**20090827150628
 Ignore-this: e1c82fdc19a22e247cd69ff6fa11921d
] 
[Allow for configurable iconv include and library locations.
Matthias Kilian <kili at outback.escape.de>**20090826154406
 Ignore-this: be95fab611a5534cf184b508964ed498
 This should help to fix the build on OpenBSD.
] 
[typo in comment
Simon Marlow <marlowsd at gmail.com>**20090826085252
 Ignore-this: 1903ee0f354157a6ed3871c100f6b1b9
] 
[un-hide some modules from the Haddock docs
Simon Marlow <marlowsd at gmail.com>**20090825152457
 Ignore-this: dce6606f93cf977fb24ebe99082dfa62
] 
[Apply fix for #1548, from squadette at gmail.com
Simon Marlow <marlowsd at gmail.com>**20090819120700
 Ignore-this: 31c237c46a6445f588ed4b8c51bb6231
] 
[improvements to Data.Fixed: instances for Typeable and Data, more predefined types
Ashley Yakeley <ashley at semantic.org>**20090812055058
 Ignore-this: feeece36d5632f02a05d137d2a39ab78
] 
[Fix "Cabal check" warnings
Ian Lynagh <igloo at earth.li>**20090811215856] 
[Add a GHC.Constants module; fixes trac #3094
Ian Lynagh <igloo at earth.li>**20090809183252] 
[Apply proposal #3393
Ian Lynagh <igloo at earth.li>**20090809134717
 Add openTempFileWithDefaultPermissions and
 openBinaryTempFileWithDefaultPermissions.
] 
[Add some more C wrappers; patch from Krister Walfridsson
Ian Lynagh <igloo at earth.li>**20090807200631
 Fixes 21 testsuite errors on NetBSD 5.99.
] 
[Fixing configure for autoconf 2.64
Alexander Dunlap <alexander.dunlap at gmail.com>**20090805060748
 Ignore-this: 992ab91ae3d68c12dbb265776e33e243
] 
[add INLINE toList
Ross Paterson <ross at soi.city.ac.uk>**20090806142853
 Ignore-this: aba16aabb17d5dca44f15d188945680e
 
 In anticipation of the fixing of #2353.
] 
[fix a copyright
Simon Marlow <marlowsd at gmail.com>**20090805134045
 Ignore-this: b0ffbdd38fbba121e8bcba37c4082a60
] 
[Tweak the BufferedIO class to enable a memory-mapped file implementation
Simon Marlow <marlowsd at gmail.com>**20090805134036
 Ignore-this: ec67d7a0a6d977438deaa342503f77e0
 We have to eliminate the assumption that an empty write buffer can be
 constructed by setting the buffer pointers to zero: this isn't
 necessarily the case when the buffer corresponds to a memory-mapped
 file, or other in-memory device implementation.
] 
[Deprecate Control.OldException
Ian Lynagh <igloo at earth.li>**20090804143910] 
[Windows build fix, following RTS tidyup
Simon Marlow <marlowsd at gmail.com>**20090803131121
 Ignore-this: ce862fb91c2b234211a8757f98690778
] 
[Updates to follow the RTS tidyup
Simon Marlow <marlowsd at gmail.com>**20090801220743
 Ignore-this: 6e92412df93a66c12d75344053d5634
 C functions like isDoubleNaN moved here (primFloat.c)
] 
[Add integer-simple as a build option
Ian Lynagh <igloo at earth.li>**20090722013151] 
[Use shift[LR]Integer in the Bits Integer instance
Ian Lynagh <igloo at earth.li>**20090721222440] 
[depend directly on integer-gmp, rather than indirecting through integer
Ian Lynagh <igloo at earth.li>**20090721185228] 
[Move the instances of Functor and Monad IO to GHC.Base, to avoid orphans
Simon Marlow <marlowsd at gmail.com>**20090722102130
 Ignore-this: a7d85ac0025d559674249de0108dbcf4
] 
[move "instance Exception Dynamic" so it isn't an orphan
Simon Marlow <marlowsd at gmail.com>**20090721093854
 Ignore-this: 5ede91ecfec2112c91b699d4de87cd02
] 
[Improve the index checking for array accesses; fixes #2120 #2669
Ian Lynagh <igloo at earth.li>**20090719153228
 As well as checking that offset we are reading is actually inside the
 array, we now also check that it is "in range" as defined by the Ix
 instance. This fixes confusing behaviour (#2120) and improves some error
 messages (#2669).
] 
[Make chr say what its argument was, if it's a bad argument
Ian Lynagh <igloo at earth.li>**20090718151049] 
[remove unused warning
Simon Marlow <marlowsd at gmail.com>**20090715124416
 Ignore-this: 31f613654089d0f4a44363946087b41e
] 
[warning fix: -fno-implicit-prelude -> -XNoImplicitPrelude
Simon Marlow <marlowsd at gmail.com>**20090715122839
 Ignore-this: dc8957249731d5bcb71c01899e5adf2b
] 
[Add hGetEncoding :: Handle -> IO (Maybe TextEncoding)
Simon Marlow <marlowsd at gmail.com>**20090715122519
 Ignore-this: 14c3eff996db062da1199739781e4708
 as suggested during the discussion on the libraries list
] 
[Add more documentation to mkTextEncoding
Simon Marlow <marlowsd at gmail.com>**20090715122414
 Ignore-this: 97253b2624267df3a246a18121e8ea81
 noting that "//IGNORE" and "//TRANSLIT" suffixes can be used with GNU
 iconv.
] 
[Add the utf8_bom codec
Simon Marlow <marlowsd at gmail.com>**20090715122257
 Ignore-this: 1c9396cd805201fe873a39382ced79c7
 as suggested during the discussion on the libraries list.
] 
[Export Unicode and newline functionality from System.IO; update Haddock docs
Simon Marlow <marlowsd at gmail.com>**20090713113104
 Ignore-this: c3f017a555335aa55d106253393f72e2
] 
[add a comment about the non-workingness of CHARBUF_UTF16
Simon Marlow <marlowsd at gmail.com>**20090707124406
 Ignore-this: 98d00411b68d688b3b4cffc9507b1f35
] 
[Fix build on Windows
Ian Lynagh <igloo at earth.li>**20090711004351] 
[Fix some "warn-unused-do-bind" warnings where we want to ignore the value
Ian Lynagh <igloo at earth.li>**20090710204513] 
[Use throwErrnoIfMinus1_ when calling getrusage
Ian Lynagh <igloo at earth.li>**20090710204221] 
[Remove an unused import
Ian Lynagh <igloo at earth.li>**20090710153345] 
[reportStackOverflow now returns IO ()
Ian Lynagh <igloo at earth.li>**20090710153257
 It used to do "return undefined" to return IO a.
] 
[GHC.Conc.reportError now returns IO ()
Ian Lynagh <igloo at earth.li>**20090710152646
 It used to return IO a, by "return undefined".
] 
[Fix some "warn-unused-do-bind" warnings where we want to ignore the value
Ian Lynagh <igloo at earth.li>**20090710152526] 
[Minor SampleVar refactoring
Ian Lynagh <igloo at earth.li>**20090710151438] 
[Fix "warn-unused-do-bind" warnings in GHC/IO/Handle/Text.hs
Ian Lynagh <igloo at earth.li>**20090710122905] 
[Fix some "warn-unused-do-bind" warnings where we just want to ignore the result
Ian Lynagh <igloo at earth.li>**20090710005638] 
[Use the result of writeCharBuf in GHC/IO/Encoding/Latin1.hs too
Ian Lynagh <igloo at earth.li>**20090710004032] 
[Minor code tidyups in GHC.Conc
Ian Lynagh <igloo at earth.li>**20090710003801] 
[Fix "warn-unused-do-bind" warning in GHC.Conc
Ian Lynagh <igloo at earth.li>**20090710003530
 If we fail to communicate with the IO manager then we print a warning
 using debugErrLn from the ghc-prim package.
] 
[Fix "warn-unused-do-bind" warnings in System.Posix.Internals
Ian Lynagh <igloo at earth.li>**20090709164546] 
[Fix "warn-unused-do-bind" warnings where we really do want to ignore the result
Ian Lynagh <igloo at earth.li>**20090709163912] 
[Add back imports needed on Windows
Ian Lynagh <igloo at earth.li>**20090707181924] 
[Remove unused imports
Ian Lynagh <igloo at earth.li>**20090707115810] 
[Remove unused imports from base
simonpj at microsoft.com**20090706111842
 Ignore-this: f9b5f353e3bb820f787c56d615b28765
 
 These unused imports are detected by the new unused-import code
 
] 
[Use the result of writeCharBuf
Simon Marlow <marlowsd at gmail.com>**20090706133303
 Ignore-this: 52288dd559bf4c4f313df6197091d935
   
 This only makes a difference when CHARBUF_UTF16 is in use, which it
 normally isn't.  I suspect CHARBUF_UTF16 doesn't currently work for
 other reasons (CHARBUF_UTF16 was an experiment before I wrote the
 GHC.IO.Encoding.UTF* codecs), but this patch at least makes it
 slightly closer to working.
] 
[Remove some cruft from Data.HashTable
Ian Lynagh <igloo at earth.li>**20090706181630] 
[Add 'eof' to Text.ParserCombinators.ReadP
simonpj at microsoft.com**20090706111801
 Ignore-this: 2aea7b848e00c894761bc4011adaa95d
 
 Add a ReadP parser that succeeds at the end of input. Very useful!
 
] 
[Don't export CLDouble for GHC; fixes trac #2793
Ian Lynagh <igloo at earth.li>**20090705155120
 We never really supported CLDouble (it was a plain old double underneath),
 and pretending that we do does more harm than good.
] 
[a byte between 0x80 and 0xBF is illegal immediately (#3341)
Simon Marlow <marlowsd at gmail.com>**20090702081415
 Ignore-this: dc19ef59a1a21118d5a7dd38aa2f611c
] 
[avoid a warning
Simon Marlow <marlowsd at gmail.com>**20090630084134
 Ignore-this: c92a45ee216faf01327feae9fe06d6e2
] 
[Add a wrapper for libiconv.
Matthias Kilian <kili at outback.escape.de>**20090629183634
 Ignore-this: 23c6047c0d71b745b495cc223574a47f
] 
[#include <sys/times.h> if we have it (should fix build problems)
Simon Marlow <marlowsd at gmail.com>**20090629085351
 Ignore-this: a35e93b37ca9595c73460243180f4b9d
] 
[set binary mode for existing FDs on Windows (fixes some GHCi test failures)
Simon Marlow <marlowsd at gmail.com>**20090626120522
 Ignore-this: 580cf636e9c77d8427aff6861d089481
] 
[Move directory-related stuff to the unix package
Simon Marlow <marlowsd at gmail.com>**20090625120325
 Ignore-this: b997b3cbce0a46ca87ad825bbdc0a411
 now that it isn't used on Windows any more.
] 
[TAG 2009-06-25
Ian Lynagh <igloo at earth.li>**20090625160056] 
Patch bundle hash:
4f095b13b68362fe860ac15b0141dbab6076d3c3


More information about the Libraries mailing list