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
25 #if WORD_SIZE_IN_BITS < 64
31 #if WORD_SIZE_IN_BITS < 64
33 #define TO64 integerToInt64
35 toByte64# :: Int64# -> Int#
36 toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))
38 -- Double mantissae have 53 bits, too much for Int#
39 elim64# :: Int64# -> Int# -> (# Integer, Int# #)
41 case zeroCount (toByte64# n) of
42 t | e <=# t -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)
43 | t <# 8# -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)
44 | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)
50 -- Double mantissae fit it Int#
51 elim64# :: Int# -> Int# -> (# Integer, Int# #)
52 elim64# = elimZerosInt#
56 {-# INLINE elimZerosInteger #-}
57 elimZerosInteger :: Integer -> Int# -> (# Integer, Int# #)
58 elimZerosInteger m e = elim64# (TO64 m) e
60 elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)
62 case zeroCount (toByte# n) of
63 t | e <=# t -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)
64 | t <# 8# -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)
65 | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)
67 {-# INLINE zeroCount #-}
68 zeroCount :: Int# -> Int#
71 BA ba -> indexInt8Array# ba i
73 toByte# :: Int# -> Int#
74 toByte# i = word2Int# (and# 255## (int2Word# i))
77 data BA = BA ByteArray#
79 -- Number of trailing zero bits in a byte
83 case newByteArray# 256# s of
85 case writeInt8Array# mba 0# 8# s1 of
87 let fillA step val idx st
88 | idx <# 256# = case writeInt8Array# mba idx val st of
89 nx -> fillA step val (idx +# step) nx
90 | step <# 256# = fillA (2# *# step) (val +# 1#) step st
92 in case fillA 2# 0# 1# s2 of
93 s3 -> case unsafeFreezeByteArray# mba s3 of
95 in case mkArr realWorld# of