diff --git a/GHC/Integer/Logarithms.hs b/GHC/Integer/Logarithms.hs
new file mode 100644
index 0000000000000000000000000000000000000000..cfafe14226a4794d6e66464b0d2851c7e3c3cfd6
--- /dev/null
+++ b/GHC/Integer/Logarithms.hs
@@ -0,0 +1,43 @@
+{-# 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#
diff --git a/GHC/Integer/Logarithms/Internals.hs b/GHC/Integer/Logarithms/Internals.hs
new file mode 100644
index 0000000000000000000000000000000000000000..c7aab33e530cabef15bfa356592f572f255069ff
--- /dev/null
+++ b/GHC/Integer/Logarithms/Internals.hs
@@ -0,0 +1,166 @@
+{-# 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
diff --git a/integer-simple.cabal b/integer-simple.cabal
index d6789bfceebc8ce32923720561bc38e63cc83361..df523104afa5f37b7dcc881132b83acd3f6a5aa2 100644
--- a/integer-simple.cabal
+++ b/integer-simple.cabal
@@ -17,6 +17,8 @@ Library {
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,