unwitch-2.2.0: src/Unwitch/Convert/Natural.hs

-- | Conversions from 'Natural'.
module Unwitch.Convert.Natural
  ( -- * Conversions
    toWord8
  , toWord16
  , toWord32
  , toWord64
  , toWord
  , toInt8
  , toInt16
  , toInt32
  , toInt64
  , toInt
  , toInteger
  , toFloat
  , toDouble
  , toCInt
  -- * Unboxed conversions
  -- $unboxed
  , toWord8#
  , toWord16#
  , toWord32#
  , toWord64#
  , toWord#
  , toInt8#
  , toInt16#
  , toInt32#
  , toInt64#
  , toInt#
  , toFloat#
  , toDouble#
  )
where

import           Unwitch.Errors
import           Unwitch.Constant
import qualified Data.Bits as Bits
import           Data.Word
import           Data.Int
import           Numeric.Natural (Natural)
import           Foreign.C.Types (CInt(CInt))
import           Prelude hiding (toInteger)
import           GHC.Exts (Int(..), Word(..), Float(..), Double(..),
                           word2Int#,
                           wordToWord8#, word8ToWord#,
                           wordToWord16#, word16ToWord#,
                           wordToWord32#, word32ToWord#,
                           wordToWord64#,
                           intToInt8#,
                           intToInt16#,
                           intToInt32#,
                           intToInt64#,
                           int2Float#, int2Double#,
                           eqWord#, leWord#, (>=#))
import           GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..))
import           GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))
import           GHC.Num.Natural (naturalToWordMaybe#)

-- $unboxed
-- These use GHC unboxed types and unboxed sums for zero-allocation
-- failure handling. Requires the @MagicHash@, @UnboxedSums@ and
-- @UnboxedTuples@ language extensions.
-- See the <https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/primitives.html GHC manual on unboxed types>.

toWord8 :: Natural -> Maybe Word8
toWord8 = Bits.toIntegralSized

toWord16 :: Natural -> Maybe Word16
toWord16 = Bits.toIntegralSized

toWord32 :: Natural -> Maybe Word32
toWord32 = Bits.toIntegralSized

toWord64 :: Natural -> Maybe Word64
toWord64 = Bits.toIntegralSized

toWord :: Natural -> Maybe Word
toWord = Bits.toIntegralSized

toInt8 :: Natural -> Maybe Int8
toInt8 = Bits.toIntegralSized

toInt16 :: Natural -> Maybe Int16
toInt16 = Bits.toIntegralSized

toInt32 :: Natural -> Maybe Int32
toInt32 = Bits.toIntegralSized

toInt64 :: Natural -> Maybe Int64
toInt64 = Bits.toIntegralSized

toInt :: Natural -> Maybe Int
toInt = Bits.toIntegralSized

toInteger :: Natural -> Integer
toInteger = fromIntegral

-- | Narrowing conversion via Int32, fails if outside Int32 range.
toCInt :: Natural -> Maybe CInt
toCInt x = CInt <$> toInt32 x

-- | Checked conversion, fails if outside exact float integer range (\u00b116777215).
toFloat :: Natural -> Either Overflows Float
toFloat x = if
  | x > maxIntegralRepFloat -> Left Overflow
  | otherwise               -> Right $ fromIntegral x

-- | Checked conversion, fails if outside exact double integer range (\u00b19007199254740991).
toDouble :: Natural -> Either Overflows Double
toDouble x = if
  | x > maxIntegralRepDouble -> Left Overflow
  | otherwise                -> Right $ fromIntegral x

-- | Via naturalToWordMaybe#, then narrow and roundtrip at Word#
toWord8# :: Natural -> (# Word8 | (# #) #)
toWord8# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) ->
    let n# = wordToWord8# w#
    in case word8ToWord# n# `eqWord#` w# of
      1# -> (# W8# n# | #)
      _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, then narrow
toWord16# :: Natural -> (# Word16 | (# #) #)
toWord16# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) ->
    let n# = wordToWord16# w#
    in case word16ToWord# n# `eqWord#` w# of
      1# -> (# W16# n# | #)
      _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, then narrow
toWord32# :: Natural -> (# Word32 | (# #) #)
toWord32# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) ->
    let n# = wordToWord32# w#
    in case word32ToWord# n# `eqWord#` w# of
      1# -> (# W32# n# | #)
      _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, then widen to Word64
toWord64# :: Natural -> (# Word64 | (# #) #)
toWord64# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) -> (# W64# (wordToWord64# w#) | #)

-- | Via naturalToWordMaybe#
toWord# :: Natural -> (# Word | (# #) #)
toWord# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) -> (# W# w# | #)

-- | Via naturalToWordMaybe#, check upper bound for Int8
toInt8# :: Natural -> (# Int8 | (# #) #)
toInt8# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) -> case leWord# w# 127## of
    1# -> (# I8# (intToInt8# (word2Int# w#)) | #)
    _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check upper bound for Int16
toInt16# :: Natural -> (# Int16 | (# #) #)
toInt16# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) -> case leWord# w# 32767## of
    1# -> (# I16# (intToInt16# (word2Int# w#)) | #)
    _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check upper bound for Int32
toInt32# :: Natural -> (# Int32 | (# #) #)
toInt32# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) -> case leWord# w# 2147483647## of
    1# -> (# I32# (intToInt32# (word2Int# w#)) | #)
    _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check fits in non-negative Int64
toInt64# :: Natural -> (# Int64 | (# #) #)
toInt64# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) ->
    let i# = word2Int# w#
    in case i# >=# 0# of
      1# -> (# I64# (intToInt64# i#) | #)
      _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, check fits in non-negative Int
toInt# :: Natural -> (# Int | (# #) #)
toInt# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# | (# #) #)
  (# | w# #) ->
    let i# = word2Int# w#
    in case i# >=# 0# of
      1# -> (# I# i# | #)
      _  -> (# | (# #) #)

-- | Via naturalToWordMaybe#, bounds-checked float
toFloat# :: Natural -> (# Overflows | Float #)
toFloat# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# Overflow | #)
  (# | w# #) -> case leWord# w# 16777215## of
    1# -> (# | F# (int2Float# (word2Int# w#)) #)
    _  -> (# Overflow | #)

-- | Via naturalToWordMaybe#, bounds-checked double
toDouble# :: Natural -> (# Overflows | Double #)
toDouble# nat = case naturalToWordMaybe# nat of
  (# (# #) | #) -> (# Overflow | #)
  (# | w# #) -> case leWord# w# 9007199254740991## of
    1# -> (# | D# (int2Double# (word2Int# w#)) #)
    _  -> (# Overflow | #)