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