GHC/Float/ConversionUtils.hs

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