    {-# 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 = Prelude.fromInteger
    -- this depends on integer-gmp
    --integerToDouble i = D# (doubleFromInteger i)

    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 #) }}}
    {-# INLINE wordToFloat #-}

    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 #) }}}
    {-# INLINE floatToWord #-}

    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 #) }}}
    {-# INLINE wordToDouble #-}

    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 #) }}}
    {-# INLINE doubleToWord #-}