Update Trac ticket URLs to point to GitLab
[ghc.git] / libraries / integer-gmp / src / GHC / Integer / Logarithms / Internals.hs
1 {-# LANGUAGE NoImplicitPrelude #-}
2 {-# LANGUAGE MagicHash #-}
3 {-# LANGUAGE UnboxedTuples #-}
4 {-# LANGUAGE CPP #-}
5
6 {-# OPTIONS_HADDOCK not-home #-}
7
8 #include "MachDeps.h"
9
10 #if WORD_SIZE_IN_BITS == 32
11 # define WSHIFT 5
12 # define MMASK 31
13 #elif WORD_SIZE_IN_BITS == 64
14 # define WSHIFT 6
15 # define MMASK 63
16 #else
17 # error unsupported WORD_SIZE_IN_BITS
18 #endif
19
20 -- | Fast 'Integer' logarithms to base 2. 'integerLog2#' and
21 -- 'wordLog2#' are of general usefulness, the others are only needed
22 -- for a fast implementation of 'fromRational'. Since they are needed
23 -- in "GHC.Float", we must expose this module, but it should not show
24 -- up in the docs.
25 --
26 -- See https://gitlab.haskell.org/ghc/ghc/issues/5122
27 -- for the origin of the code in this module
28 module GHC.Integer.Logarithms.Internals
29 ( wordLog2#
30 , integerLog2IsPowerOf2#
31 , integerLog2#
32 , roundingMode#
33 ) where
34
35 import GHC.Integer.Type
36 import GHC.Integer.Logarithms
37
38 import GHC.Types
39 import GHC.Prim
40
41 default ()
42
43 -- | Extended version of 'integerLog2#'
44 --
45 -- Assumption: Integer is strictly positive
46 --
47 -- First component of result is @log2 n@, second is @0#@ iff /n/ is a
48 -- power of two.
49 integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
50 -- The power of 2 test is n&(n-1) == 0, thus powers of 2
51 -- are indicated bythe second component being zero.
52 integerLog2IsPowerOf2# (S# i#) = case int2Word# i# of
53 w -> (# wordLog2# w, word2Int# (w `and#` (w `minusWord#` 1##)) #)
54 integerLog2IsPowerOf2# (Jn# _) = (# -1#, -1# #)
55 -- Find the log2 as above, test whether that word is a power
56 -- of 2, if so, check whether only zero bits follow.
57 integerLog2IsPowerOf2# (Jp# bn) = check (s -# 1#)
58 where
59 s = sizeofBigNat# bn
60 check :: Int# -> (# Int#, Int# #)
61 check i = case indexBigNat# bn i of
62 0## -> check (i -# 1#)
63 w -> (# wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
64 , case w `and#` (w `minusWord#` 1##) of
65 0## -> test (i -# 1#)
66 _ -> 1# #)
67 test :: Int# -> Int#
68 test i = if isTrue# (i <# 0#)
69 then 0#
70 else case indexBigNat# bn i of
71 0## -> test (i -# 1#)
72 _ -> 1#
73
74
75 -- Assumption: Integer and Int# are strictly positive, Int# is less
76 -- than logBase 2 of Integer, otherwise havoc ensues.
77 -- Used only for the numerator in fromRational when the denominator
78 -- is a power of 2.
79 -- The Int# argument is log2 n minus the number of bits in the mantissa
80 -- of the target type, i.e. the index of the first non-integral bit in
81 -- the quotient.
82 --
83 -- 0# means round down (towards zero)
84 -- 1# means we have a half-integer, round to even
85 -- 2# means round up (away from zero)
86 roundingMode# :: Integer -> Int# -> Int#
87 roundingMode# (S# i#) t =
88 case int2Word# i# `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of
89 k -> case uncheckedShiftL# 1## t of
90 c -> if isTrue# (c `gtWord#` k)
91 then 0#
92 else if isTrue# (c `ltWord#` k)
93 then 2#
94 else 1#
95
96 roundingMode# (Jn# bn) t = roundingMode# (Jp# bn) t -- dummy
97 roundingMode# (Jp# bn) t =
98 case word2Int# (int2Word# t `and#` MMASK##) of
99 j -> -- index of relevant bit in word
100 case uncheckedIShiftRA# t WSHIFT# of
101 k -> -- index of relevant word
102 case indexBigNat# bn k `and#`
103 ((uncheckedShiftL# 2## j) `minusWord#` 1##) of
104 r ->
105 case uncheckedShiftL# 1## j of
106 c -> if isTrue# (c `gtWord#` r)
107 then 0#
108 else if isTrue# (c `ltWord#` r)
109
110
111 then 2#
112 else test (k -# 1#)
113 where
114 test i = if isTrue# (i <# 0#)
115 then 1#
116 else case indexBigNat# bn i of
117 0## -> test (i -# 1#)
118 _ -> 2#