Ticket #5122: logarithms-integer-gmp-and-haddock-fix.dpatch

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@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@googlemail.com>
  * Fix Haddock markup

New patches:

[Integer logarithms
Daniel Fischer <daniel.is.fischer@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@.
+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@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@.
 integerLogBase# :: Integer -> Integer -> Int#

Context:

[Call the final build system phase "final" rather than ""
Ian Lynagh <igloo@earth.li>**20110206203232
 Ignore-this: 929994164005f2449ee56ab8a0c07fab
] 
[Update for changes in GHC's build system
Ian Lynagh <igloo@earth.li>**20110122194756
 Ignore-this: e4e98a7ff8a7800f228f59e9452746cf
] 
[Correct the gmp build phase
Ian Lynagh <igloo@earth.li>**20110117122245
 Ignore-this: bc26aafe9526a942f5a381fb3688d7a9
] 
[Tidy up gmp cleaning
Ian Lynagh <igloo@earth.li>**20110117121224
 Ignore-this: 25007c0d1482705f5390e29a86ed6a66
] 
[Add extensions to LANGUAGE pragmas
Ian Lynagh <igloo@earth.li>**20110111003050] 
[Fix unknown symbol base_ControlziExceptionziBase_patError_info by helping GHC generate smarter core.
Edward Z. Yang <ezyang@mit.edu>**20101204013010
 Ignore-this: df2991ab1f4321c8777af7f7c1415d29
] 
[Add LANGUAGE BangPatterns to modules that use bang patterns
simonpj@microsoft.com**20101112170604
 Ignore-this: bd8280707c084644c185d5fb01e583f0
] 
[Add a rewrite rule for toInt# so literals work right
simonpj@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@earth.li>**20101023153631
 Ignore-this: 4ce6102919eccb7335756bd4001a2322
] 
[Bump version number to 0.2.0.2
Ian Lynagh <igloo@earth.li>**20100916170032] 
[Fix compile warning on 32bit machine
David Terei <davidterei@gmail.com>**20100817103407
 Ignore-this: 30b715c759d3721a4651c3c94054813
] 
[fix hashInteger to be the same as fromIntegral, and document it (#4108)
Simon Marlow <marlowsd@gmail.com>**20100813153142
 Ignore-this: 5778949a68115bd65464b2b3d4bf4834
] 
[implement integer2Int# and integer2Word# in Haskell, not foreign prim
Simon Marlow <marlowsd@gmail.com>**20100813152926
 Ignore-this: e06beace47751538e72e7b1615ff6dcf
] 
[Use the stage-specific CONF_CC_OPTS variables
Ian Lynagh <igloo@earth.li>**20100723135933] 
[TAG Haskell 2010 report generated
Simon Marlow <marlowsd@gmail.com>**20100705150919
 Ignore-this: 9e76b0809ef3e0cd86b2dd0efb9c0fb7
] 
Patch bundle hash:
e5680d9c3fb3479e4478757e0dbb7c7d4393d2eb