{-# 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 = Integer -> Double
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 (Integer -> Double) -> (Natural -> Integer) -> Natural -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Integer
forall a. Integral a => a -> Integer
Prelude.toInteger

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

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

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

wordToFloat :: Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat (W32# Word32#
x) = (forall s. ST s Float) -> Float
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Float) -> Float)
-> (forall s. ST s Float) -> Float
forall a b. (a -> b) -> a -> b
$ STRep s Float -> ST s Float
forall s a. STRep s a -> ST s a
ST (STRep s Float -> ST s Float) -> STRep s Float -> ST s Float
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
4# State# s
s1             of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s
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 MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
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 s. ST s Word32) -> Word32
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Word32) -> Word32)
-> (forall s. ST s Word32) -> Word32
forall a b. (a -> b) -> a -> b
$ STRep s Word32 -> ST s Word32
forall s a. STRep s a -> ST s a
ST (STRep s Word32 -> ST s Word32) -> STRep s Word32 -> ST s Word32
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
4# State# s
s1            of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
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 MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #)
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# Word64#
x) = (forall s. ST s Double) -> Double
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Double) -> Double)
-> (forall s. ST s Double) -> Double
forall a b. (a -> b) -> a -> b
$ STRep s Double -> ST s Double
forall s a. STRep s a -> ST s a
ST (STRep s Double -> ST s Double) -> STRep s Double -> ST s Double
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
8# State# s
s1             of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word64# -> State# d -> State# d
writeWord64Array# MutableByteArray# s
mbarr Int#
0# Word64#
x State# s
s2 of { State# s
s3              ->
    case MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
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 s. ST s Word64) -> Word64
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Word64) -> Word64)
-> (forall s. ST s Word64) -> Word64
forall a b. (a -> b) -> a -> b
$ STRep s Word64 -> ST s Word64
forall s a. STRep s a -> ST s a
ST (STRep s Word64 -> ST s Word64) -> STRep s Word64 -> ST s Word64
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
8# State# s
s1             of { (# State# s
s2, MutableByteArray# s
mbarr #) ->
    case MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
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 MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word64# #)
readWord64Array# MutableByteArray# s
mbarr Int#
0# State# s
s3    of { (# State# s
s4, Word64#
w #)     ->
        (# State# s
s4, Word64# -> Word64
W64# Word64#
w #) }}}
{-# INLINE doubleToWord #-}