{-|
Module      : Z.Data.Array.Cast
Description : Primitive casting
Copyright   : Haskell Foundation, (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module is borrowed from basement's Cast module with conditional instances removed. The purpose of 'Cast' is to provide primitive types which share the same byte size, so that arrays and vectors parameterized by them can be safely coerced without breaking the index bounds. You can also use it to directly cast primitives just like @reinterpret_cast@. A 'Coercible' based instance is also provide for convenience.

-}

#include "MachDeps.h"

module Z.Data.Array.Cast
    ( Cast(..)
    ) where

import           GHC.Exts
import           GHC.Int
import           GHC.Word
#if WORD_SIZE_IN_BITS < 64
import           GHC.IntWord64
#endif
import           GHC.Float



-- | `Cast` between primitive types of the same size.
--
class Cast source destination where
    cast :: source -> destination

instance {-# INCOHERENT #-} Coercible a b => Cast a b where
    cast :: a -> b
cast = a -> b
coerce

instance Cast Int8  Word8 where
    {-# INLINE cast #-}
    cast :: Int8 -> Word8
cast (I8# Int#
i) = Word# -> Word8
W8# (Word# -> Word#
narrow8Word# (Int# -> Word#
int2Word# Int#
i))
instance Cast Int16 Word16 where
    {-# INLINE cast #-}
    cast :: Int16 -> Word16
cast (I16# Int#
i) = Word# -> Word16
W16# (Word# -> Word#
narrow16Word# (Int# -> Word#
int2Word# Int#
i))
instance Cast Int32 Word32 where
    {-# INLINE cast #-}
    cast :: Int32 -> Word32
cast (I32# Int#
i) = Word# -> Word32
W32# (Word# -> Word#
narrow32Word# (Int# -> Word#
int2Word# Int#
i))
instance Cast Int64 Word64 where
    {-# INLINE cast #-}
#if WORD_SIZE_IN_BITS < 64
    cast (I64# i) = W64# (int64ToWord64# i)
#else
    cast :: Int64 -> Word64
cast (I64# Int#
i) = Word# -> Word64
W64# (Int# -> Word#
int2Word# Int#
i)
#endif
instance Cast Int   Word where
    {-# INLINE cast #-}
    cast :: Int -> Word
cast (I# Int#
i) = Word# -> Word
W# (Int# -> Word#
int2Word# Int#
i)

instance Cast Word8  Int8 where
    {-# INLINE cast #-}
    cast :: Word8 -> Int8
cast (W8# Word#
i) = Int# -> Int8
I8# (Int# -> Int#
narrow8Int# (Word# -> Int#
word2Int# Word#
i))
instance Cast Word16 Int16 where
    {-# INLINE cast #-}
    cast :: Word16 -> Int16
cast (W16# Word#
i) = Int# -> Int16
I16# (Int# -> Int#
narrow16Int# (Word# -> Int#
word2Int# Word#
i))
instance Cast Word32 Int32 where
    {-# INLINE cast #-}
    cast :: Word32 -> Int32
cast (W32# Word#
i) = Int# -> Int32
I32# (Int# -> Int#
narrow32Int# (Word# -> Int#
word2Int# Word#
i))
instance Cast Word64 Int64 where
    {-# INLINE cast #-}
#if WORD_SIZE_IN_BITS < 64
    cast (W64# i) = I64# (word64ToInt64# i)
#else
    cast :: Word64 -> Int64
cast (W64# Word#
i) = Int# -> Int64
I64# (Word# -> Int#
word2Int# Word#
i)
#endif
instance Cast Word   Int where
    {-# INLINE cast #-}
    cast :: Word -> Int
cast (W# Word#
w) = Int# -> Int
I# (Word# -> Int#
word2Int# Word#
w)

instance Cast Word64 Double where
    {-# INLINE cast #-}
    cast :: Word64 -> Double
cast = Word64 -> Double
castWord64ToDouble
instance Cast Word32 Float where
    {-# INLINE cast #-}
    cast :: Word32 -> Float
cast = Word32 -> Float
castWord32ToFloat
instance Cast Double Word64 where
    {-# INLINE cast #-}
    cast :: Double -> Word64
cast = Double -> Word64
castDoubleToWord64
instance Cast Float Word32 where
    {-# INLINE cast #-}
    cast :: Float -> Word32
cast = Float -> Word32
castFloatToWord32

instance Cast Int64 Double where
    {-# INLINE cast #-}
    cast :: Int64 -> Double
cast = Word64 -> Double
castWord64ToDouble (Word64 -> Double) -> (Int64 -> Word64) -> Int64 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall source destination.
Cast source destination =>
source -> destination
cast
instance Cast Int32 Float where
    {-# INLINE cast #-}
    cast :: Int32 -> Float
cast = Word32 -> Float
castWord32ToFloat (Word32 -> Float) -> (Int32 -> Word32) -> Int32 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall source destination.
Cast source destination =>
source -> destination
cast
instance Cast Double Int64 where
    {-# INLINE cast #-}
    cast :: Double -> Int64
cast = Word64 -> Int64
forall source destination.
Cast source destination =>
source -> destination
cast (Word64 -> Int64) -> (Double -> Word64) -> Double -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
castDoubleToWord64
instance Cast Float Int32 where
    {-# INLINE cast #-}
    cast :: Float -> Int32
cast = Word32 -> Int32
forall source destination.
Cast source destination =>
source -> destination
cast (Word32 -> Int32) -> (Float -> Word32) -> Float -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
castFloatToWord32