1 {-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
2 {-# OPTIONS_GHC -O2 #-}
3 {-# OPTIONS_HADDOCK hide #-}
4 -----------------------------------------------------------------------------
6 -- Module : GHC.Float.ConversionUtils
7 -- Copyright : (c) Daniel Fischer 2010
8 -- License : see libraries/base/LICENSE
10 -- Maintainer : cvs-ghc@haskell.org
11 -- Stability : internal
12 -- Portability : non-portable (GHC Extensions)
14 -- Utilities for conversion between Double/Float and Rational
16 -----------------------------------------------------------------------------
21 module GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where
29 #if WORD_SIZE_IN_BITS < 64
31 #define TO64 integerToInt64
33 toByte64# :: Int64# -> Int#
34 toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))
36 -- Double mantissae have 53 bits, too much for Int#
37 elim64# :: Int64# -> Int# -> (# Integer, Int# #)
39 case zeroCount (toByte64# n) of
40 t | e <=# t -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)
41 | t <# 8# -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)
42 | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)
48 -- Double mantissae fit it Int#
49 elim64# :: Int# -> Int# -> (# Integer, Int# #)
50 elim64# = elimZerosInt#
54 {-# INLINE elimZerosInteger #-}
55 elimZerosInteger :: Integer -> Int# -> (# Integer, Int# #)
56 elimZerosInteger m e = elim64# (TO64 m) e
58 elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)
60 case zeroCount (toByte# n) of
61 t | e <=# t -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)
62 | t <# 8# -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)
63 | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)
65 {-# INLINE zeroCount #-}
66 zeroCount :: Int# -> Int#
69 BA ba -> indexInt8Array# ba i
71 toByte# :: Int# -> Int#
72 toByte# i = word2Int# (and# 255## (int2Word# i))
75 data BA = BA ByteArray#
77 -- Number of trailing zero bits in a byte
81 case newByteArray# 256# s of
83 case writeInt8Array# mba 0# 8# s1 of
85 let fillA step val idx st
86 | idx <# 256# = case writeInt8Array# mba idx val st of
87 nx -> fillA step val (idx +# step) nx
88 | step <# 256# = fillA (2# *# step) (val +# 1#) step st
90 in case fillA 2# 0# 1# s2 of
91 s3 -> case unsafeFreezeByteArray# mba s3 of
93 in case mkArr realWorld# of