Update base for latest Safe Haskell.
[packages/base.git] / GHC / Float / ConversionUtils.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
3 {-# OPTIONS_GHC -O2 #-}
4 {-# OPTIONS_HADDOCK hide #-}
5
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module : GHC.Float.ConversionUtils
9 -- Copyright : (c) Daniel Fischer 2010
10 -- License : see libraries/base/LICENSE
11 --
12 -- Maintainer : cvs-ghc@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable (GHC Extensions)
15 --
16 -- Utilities for conversion between Double/Float and Rational
17 --
18 -----------------------------------------------------------------------------
19
20 #include "MachDeps.h"
21
22 -- #hide
23 module GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where
24
25 import GHC.Base
26 import GHC.Integer
27 #if WORD_SIZE_IN_BITS < 64
28 import GHC.IntWord64
29 #endif
30
31 default ()
32
33 #if WORD_SIZE_IN_BITS < 64
34
35 #define TO64 integerToInt64
36
37 toByte64# :: Int64# -> Int#
38 toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))
39
40 -- Double mantissae have 53 bits, too much for Int#
41 elim64# :: Int64# -> Int# -> (# Integer, Int# #)
42 elim64# n e =
43 case zeroCount (toByte64# n) of
44 t | e <=# t -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)
45 | t <# 8# -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)
46 | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)
47
48 #else
49
50 #define TO64 integerToInt
51
52 -- Double mantissae fit it Int#
53 elim64# :: Int# -> Int# -> (# Integer, Int# #)
54 elim64# = elimZerosInt#
55
56 #endif
57
58 {-# INLINE elimZerosInteger #-}
59 elimZerosInteger :: Integer -> Int# -> (# Integer, Int# #)
60 elimZerosInteger m e = elim64# (TO64 m) e
61
62 elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)
63 elimZerosInt# n e =
64 case zeroCount (toByte# n) of
65 t | e <=# t -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)
66 | t <# 8# -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)
67 | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)
68
69 {-# INLINE zeroCount #-}
70 zeroCount :: Int# -> Int#
71 zeroCount i =
72 case zeroCountArr of
73 BA ba -> indexInt8Array# ba i
74
75 toByte# :: Int# -> Int#
76 toByte# i = word2Int# (and# 255## (int2Word# i))
77
78
79 data BA = BA ByteArray#
80
81 -- Number of trailing zero bits in a byte
82 zeroCountArr :: BA
83 zeroCountArr =
84 let mkArr s =
85 case newByteArray# 256# s of
86 (# s1, mba #) ->
87 case writeInt8Array# mba 0# 8# s1 of
88 s2 ->
89 let fillA step val idx st
90 | idx <# 256# = case writeInt8Array# mba idx val st of
91 nx -> fillA step val (idx +# step) nx
92 | step <# 256# = fillA (2# *# step) (val +# 1#) step st
93 | otherwise = st
94 in case fillA 2# 0# 1# s2 of
95 s3 -> case unsafeFreezeByteArray# mba s3 of
96 (# _, ba #) -> ba
97 in case mkArr realWorld# of
98 b -> BA b
99