1-- | 2-- Module: GHC.Integer.Logarithms.Compat 3-- Copyright: (c) 2011 Daniel Fischer 4-- Licence: MIT 5-- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com> 6-- Stability: Provisional 7-- Portability: Non-portable (GHC extensions) 8-- 9-- Low level stuff for integer logarithms. 10{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} 11#if __GLASGOW_HASKELL__ >= 702 12{-# LANGUAGE Trustworthy #-} 13#endif 14module GHC.Integer.Logarithms.Compat 15 ( -- * Functions 16 integerLogBase# 17 , integerLog2# 18 , wordLog2# 19 ) where 20 21#if __GLASGOW_HASKELL__ >= 702 22 23-- Stuff is already there 24import GHC.Integer.Logarithms 25 26#else 27 28-- We have to define it here 29#include "MachDeps.h" 30 31import GHC.Base 32import GHC.Integer.GMP.Internals 33 34#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64) 35#error Only word sizes 32 and 64 are supported. 36#endif 37 38 39#if WORD_SIZE_IN_BITS == 32 40 41#define WSHIFT 5 42#define MMASK 31 43 44#else 45 46#define WSHIFT 6 47#define MMASK 63 48 49#endif 50 51-- Reference implementation only, the algorithm in M.NT.Logarithms is better. 52 53-- | Calculate the integer logarithm for an arbitrary base. 54-- The base must be greater than 1, the second argument, the number 55-- whose logarithm is sought; should be positive, otherwise the 56-- result is meaningless. 57-- 58-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1) 59-- 60-- for @base > 1@ and @m > 0@. 61integerLogBase# :: Integer -> Integer -> Int# 62integerLogBase# b m = case step b of 63 (# _, e #) -> e 64 where 65 step pw = 66 if m < pw 67 then (# m, 0# #) 68 else case step (pw * pw) of 69 (# q, e #) -> 70 if q < pw 71 then (# q, 2# *# e #) 72 else (# q `quot` pw, 2# *# e +# 1# #) 73 74-- | Calculate the integer base 2 logarithm of an 'Integer'. 75-- The calculation is much more efficient than for the general case. 76-- 77-- The argument must be strictly positive, that condition is /not/ checked. 78integerLog2# :: Integer -> Int# 79integerLog2# (S# i) = wordLog2# (int2Word# i) 80integerLog2# (J# s ba) = check (s -# 1#) 81 where 82 check i = case indexWordArray# ba i of 83 0## -> check (i -# 1#) 84 w -> wordLog2# w +# (uncheckedIShiftL# i WSHIFT#) 85 86-- | This function calculates the integer base 2 logarithm of a 'Word#'. 87-- @'wordLog2#' 0## = -1#@. 88{-# INLINE wordLog2# #-} 89wordLog2# :: Word# -> Int# 90wordLog2# w = 91 case leadingZeros of 92 BA lz -> 93 let zeros u = indexInt8Array# lz (word2Int# u) in 94#if WORD_SIZE_IN_BITS == 64 95 case uncheckedShiftRL# w 56# of 96 a -> 97 if a `neWord#` 0## 98 then 64# -# zeros a 99 else 100 case uncheckedShiftRL# w 48# of 101 b -> 102 if b `neWord#` 0## 103 then 56# -# zeros b 104 else 105 case uncheckedShiftRL# w 40# of 106 c -> 107 if c `neWord#` 0## 108 then 48# -# zeros c 109 else 110 case uncheckedShiftRL# w 32# of 111 d -> 112 if d `neWord#` 0## 113 then 40# -# zeros d 114 else 115#endif 116 case uncheckedShiftRL# w 24# of 117 e -> 118 if e `neWord#` 0## 119 then 32# -# zeros e 120 else 121 case uncheckedShiftRL# w 16# of 122 f -> 123 if f `neWord#` 0## 124 then 24# -# zeros f 125 else 126 case uncheckedShiftRL# w 8# of 127 g -> 128 if g `neWord#` 0## 129 then 16# -# zeros g 130 else 8# -# zeros w 131 132-- Lookup table 133data BA = BA ByteArray# 134 135leadingZeros :: BA 136leadingZeros = 137 let mkArr s = 138 case newByteArray# 256# s of 139 (# s1, mba #) -> 140 case writeInt8Array# mba 0# 9# s1 of 141 s2 -> 142 let fillA lim val idx st = 143 if idx ==# 256# 144 then st 145 else if idx <# lim 146 then case writeInt8Array# mba idx val st of 147 nx -> fillA lim val (idx +# 1#) nx 148 else fillA (2# *# lim) (val -# 1#) idx st 149 in case fillA 2# 8# 1# s2 of 150 s3 -> case unsafeFreezeByteArray# mba s3 of 151 (# _, ba #) -> ba 152 in case mkArr realWorld# of 153 b -> BA b 154 155#endif 156