module Basement.Floating
( integerToDouble
, naturalToDouble
, doubleExponant
, integerToFloat
, naturalToFloat
, wordToFloat
, floatToWord
, wordToDouble
, doubleToWord
) where
import GHC.Types
import GHC.Prim
import GHC.Float
import GHC.Word
import GHC.ST
import Basement.Compat.Base
import Basement.Compat.Natural
import qualified Prelude (fromInteger, toInteger, (^^))
integerToDouble :: Integer -> Double
integerToDouble = Prelude.fromInteger
naturalToDouble :: Natural -> Double
naturalToDouble = integerToDouble . Prelude.toInteger
doubleExponant :: Double -> Int -> Double
doubleExponant = (Prelude.^^)
integerToFloat :: Integer -> Float
integerToFloat = Prelude.fromInteger
naturalToFloat :: Natural -> Float
naturalToFloat = integerToFloat . Prelude.toInteger
wordToFloat :: Word32 -> Float
wordToFloat (W32# x) = runST $ ST $ \s1 ->
case newByteArray# 4# s1 of { (# s2, mbarr #) ->
case writeWord32Array# mbarr 0# x s2 of { s3 ->
case readFloatArray# mbarr 0# s3 of { (# s4, f #) ->
(# s4, F# f #) }}}
floatToWord :: Float -> Word32
floatToWord (F# x) = runST $ ST $ \s1 ->
case newByteArray# 4# s1 of { (# s2, mbarr #) ->
case writeFloatArray# mbarr 0# x s2 of { s3 ->
case readWord32Array# mbarr 0# s3 of { (# s4, w #) ->
(# s4, W32# w #) }}}
wordToDouble :: Word64 -> Double
wordToDouble (W64# x) = runST $ ST $ \s1 ->
case newByteArray# 8# s1 of { (# s2, mbarr #) ->
case writeWord64Array# mbarr 0# x s2 of { s3 ->
case readDoubleArray# mbarr 0# s3 of { (# s4, f #) ->
(# s4, D# f #) }}}
doubleToWord :: Double -> Word64
doubleToWord (D# x) = runST $ ST $ \s1 ->
case newByteArray# 8# s1 of { (# s2, mbarr #) ->
case writeDoubleArray# mbarr 0# x s2 of { s3 ->
case readWord64Array# mbarr 0# s3 of { (# s4, w #) ->
(# s4, W64# w #) }}}