2 patches for repository /home/dafis/Haskell/Hacking/ghc/libraries/integer-gmp: Wed Mar 30 18:18:52 CEST 2011 Daniel Fischer * Integer logarithms Added modules for fast calculation of integer logarithms needed for fromRational. Thu Mar 31 01:17:10 CEST 2011 Daniel Fischer * Fix Haddock markup New patches: [Integer logarithms Daniel Fischer **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 **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 **20110206203232 Ignore-this: 929994164005f2449ee56ab8a0c07fab ] [Update for changes in GHC's build system Ian Lynagh **20110122194756 Ignore-this: e4e98a7ff8a7800f228f59e9452746cf ] [Correct the gmp build phase Ian Lynagh **20110117122245 Ignore-this: bc26aafe9526a942f5a381fb3688d7a9 ] [Tidy up gmp cleaning Ian Lynagh **20110117121224 Ignore-this: 25007c0d1482705f5390e29a86ed6a66 ] [Add extensions to LANGUAGE pragmas Ian Lynagh **20110111003050] [Fix unknown symbol base_ControlziExceptionziBase_patError_info by helping GHC generate smarter core. Edward Z. Yang **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 **20101023153631 Ignore-this: 4ce6102919eccb7335756bd4001a2322 ] [Bump version number to 0.2.0.2 Ian Lynagh **20100916170032] [Fix compile warning on 32bit machine David Terei **20100817103407 Ignore-this: 30b715c759d3721a4651c3c94054813 ] [fix hashInteger to be the same as fromIntegral, and document it (#4108) Simon Marlow **20100813153142 Ignore-this: 5778949a68115bd65464b2b3d4bf4834 ] [implement integer2Int# and integer2Word# in Haskell, not foreign prim Simon Marlow **20100813152926 Ignore-this: e06beace47751538e72e7b1615ff6dcf ] [Use the stage-specific CONF_CC_OPTS variables Ian Lynagh **20100723135933] [TAG Haskell 2010 report generated Simon Marlow **20100705150919 Ignore-this: 9e76b0809ef3e0cd86b2dd0efb9c0fb7 ] Patch bundle hash: e5680d9c3fb3479e4478757e0dbb7c7d4393d2eb