{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
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 :: Integer -> Double
integerToDouble = forall a. Num a => Integer -> a
Prelude.fromInteger
-- this depends on integer-gmp
--integerToDouble i = D# (doubleFromInteger i)

naturalToDouble :: Natural -> Double
naturalToDouble :: Natural -> Double
naturalToDouble = Integer -> Double
integerToDouble forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Integral a => a -> Integer
Prelude.toInteger

doubleExponant :: Double -> Int -> Double
doubleExponant :: Double -> Int -> Double
doubleExponant = forall a b. (Fractional a, Integral b) => a -> b -> a
(Prelude.^^)

integerToFloat :: Integer -> Float
integerToFloat :: Integer -> Float
integerToFloat = forall a. Num a => Integer -> a
Prelude.fromInteger

naturalToFloat :: Natural -> Float
naturalToFloat :: Natural -> Float
naturalToFloat = Integer -> Float
integerToFloat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Integral a => a -> Integer
Prelude.toInteger

wordToFloat :: Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat (W32# Word32#
x) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
4# State# s
s1             of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case forall d.
MutableByteArray# d -> Int# -> Word32# -> State# d -> State# d
writeWord32Array# MutableByteArray# s
mbarr Int#
0# Word32#
x State# s
s2 of { State# s
s3              ->
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
readFloatArray# MutableByteArray# s
mbarr Int#
0# State# s
s3     of { (# State# s
s4, Float#
f #)     ->
        (# State# s
s4, Float# -> Float
F# Float#
f #) }}}
{-# INLINE wordToFloat #-}

floatToWord :: Float -> Word32
floatToWord :: Float -> Word32
floatToWord (F# Float#
x) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
4# State# s
s1            of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# s
mbarr Int#
0# Float#
x State# s
s2 of { State# s
s3              ->
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word32# #)
readWord32Array# MutableByteArray# s
mbarr Int#
0# State# s
s3   of { (# State# s
s4, Word32#
w #)     ->
        (# State# s
s4, Word32# -> Word32
W32# Word32#
w #) }}}
{-# INLINE floatToWord #-}

wordToDouble :: Word64 -> Double
wordToDouble :: Word64 -> Double
wordToDouble (W64# Word#
x) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
8# State# s
s1             of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord64Array# MutableByteArray# s
mbarr Int#
0# Word#
x State# s
s2 of { State# s
s3              ->
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
readDoubleArray# MutableByteArray# s
mbarr Int#
0# State# s
s3    of { (# State# s
s4, Double#
f #)     ->
        (# State# s
s4, Double# -> Double
D# Double#
f #) }}}
{-# INLINE wordToDouble #-}

doubleToWord :: Double -> Word64
doubleToWord :: Double -> Word64
doubleToWord (D# Double#
x) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
8# State# s
s1             of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeDoubleArray# MutableByteArray# s
mbarr Int#
0# Double#
x State# s
s2 of { State# s
s3              ->
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord64Array# MutableByteArray# s
mbarr Int#
0# State# s
s3    of { (# State# s
s4, Word#
w #)     ->
        (# State# s
s4, Word# -> Word64
W64# Word#
w #) }}}
{-# INLINE doubleToWord #-}