78 lines
2.5 KiB
Haskell
78 lines
2.5 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE RebindableSyntax #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# 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 #-}
|