{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators         #-}
-- |
-- Module      : Basement.Cast
-- License     : BSD-style
-- Maintainer  : Haskell Foundation
--
module Basement.Cast
    ( Cast(..)
    ) where

#include "MachDeps.h"

import qualified Basement.Block.Base as Block
import           Basement.Compat.Base
import           Basement.Compat.Natural
import           Basement.Compat.Primitive
import           Basement.Numerical.Number
import           Basement.Numerical.Conversion
import           Basement.PrimType

import           Data.Proxy (Proxy(..))

import           GHC.Int
import           GHC.Prim
import           GHC.Types
import           GHC.ST
import           GHC.Word

-- | `Cast` an object of type a to b.
--
-- Do not add instance of this class if the source type is not of the same
-- size of the destination type. Also keep in mind this is casting a value
-- of a given type into a destination type. The value won't be changed to
-- fit the destination represention.
--
-- If you wish to convert a value of a given type into another type, look at
-- `From` and `TryFrom`.
--
-- @
-- cast (-10 :: Int) :: Word === 18446744073709551606
-- @
--
class Cast source destination where
    cast :: source -> destination

    default cast :: ( PrimType source
                    , PrimType destination
                    , PrimSize source ~ PrimSize destination
                    )
                 => source -> destination
    cast source
a = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MutableBlock source s
mba <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.new CountOf source
1
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
Block.unsafeWrite MutableBlock source s
mba Offset source
0 source
a
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
Block.unsafeRead (forall t1 t2 st.
(PrimType t1, PrimType t2) =>
MutableBlock t1 st -> MutableBlock t2 st
Block.unsafeRecast MutableBlock source s
mba) Offset destination
0

instance Cast Int8  Word8 where
    cast :: Int8 -> Word8
cast (I8# Int8#
i) = Word8# -> Word8
W8# (Word# -> Word8#
wordToWord8# (Int# -> Word#
int2Word# (Int8# -> Int#
int8ToInt# Int8#
i)))
instance Cast Int16 Word16 where
    cast :: Int16 -> Word16
cast (I16# Int16#
i) = Word16# -> Word16
W16# (Word# -> Word16#
wordToWord16# (Int# -> Word#
int2Word# (Int16# -> Int#
int16ToInt# Int16#
i)))
instance Cast Int32 Word32 where
    cast :: Int32 -> Word32
cast (I32# Int32#
i) = Word32# -> Word32
W32# (Word# -> Word32#
wordToWord32# (Int# -> Word#
int2Word# (Int32# -> Int#
int32ToInt# Int32#
i)))
instance Cast Int64 Word64 where
    cast :: Int64 -> Word64
cast = Int64 -> Word64
int64ToWord64
instance Cast Int   Word where
    cast :: Int -> Word
cast (I# Int#
i) = Word# -> Word
W# (Int# -> Word#
int2Word# Int#
i)

instance Cast Word8  Int8 where
    cast :: Word8 -> Int8
cast (W8# Word8#
i) = Int8# -> Int8
I8# (Int# -> Int8#
intToInt8# (Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
i)))
instance Cast Word16 Int16 where
    cast :: Word16 -> Int16
cast (W16# Word16#
i) = Int16# -> Int16
I16# (Int# -> Int16#
intToInt16# (Word# -> Int#
word2Int# (Word16# -> Word#
word16ToWord# Word16#
i)))
instance Cast Word32 Int32 where
    cast :: Word32 -> Int32
cast (W32# Word32#
i) = Int32# -> Int32
I32# (Int# -> Int32#
intToInt32# (Word# -> Int#
word2Int# (Word32# -> Word#
word32ToWord# Word32#
i)))
instance Cast Word64 Int64 where
    cast :: Word64 -> Int64
cast = Word64 -> Int64
word64ToInt64
instance Cast Word   Int where
    cast :: Word -> Int
cast (W# Word#
w) = Int# -> Int
I# (Word# -> Int#
word2Int# Word#
w)

#if WORD_SIZE_IN_BITS == 64
#if __GLASGOW_HASKELL__ >= 904
instance Cast Word   Word64 where
    cast (W# w) = W64# (wordToWord64# w)
instance Cast Word64 Word where
    cast (W64# w) = W# (GHC.Prim.word64ToWord# w)

instance Cast Word   Int64 where
    cast (W# w) = I64# (intToInt64# (word2Int# w))
instance Cast Int64  Word where
    cast (I64# i) = W# (int2Word# (int64ToInt# i))

instance Cast Int    Int64 where
    cast (I# i) = I64# (intToInt64# i)
instance Cast Int64  Int where
    cast (I64# i) = I# (int64ToInt# i)

instance Cast Int    Word64 where
    cast (I# i) = W64# (wordToWord64# (int2Word# i))
instance Cast Word64 Int where
    cast (W64# w) = I# (word2Int# (GHC.Prim.word64ToWord# w))
#else
instance Cast Word   Word64 where
    cast :: Word -> Word64
cast (W# Word#
w) = Word# -> Word64
W64# Word#
w
instance Cast Word64 Word where
    cast :: Word64 -> Word
cast (W64# Word#
w) = Word# -> Word
W# Word#
w

instance Cast Word   Int64 where
    cast :: Word -> Int64
cast (W# Word#
w) = Int# -> Int64
I64# (Word# -> Int#
word2Int# Word#
w)
instance Cast Int64  Word where
    cast :: Int64 -> Word
cast (I64# Int#
i) = Word# -> Word
W# (Int# -> Word#
int2Word# Int#
i)

instance Cast Int    Int64 where
    cast :: Int -> Int64
cast (I# Int#
i) = Int# -> Int64
I64# Int#
i
instance Cast Int64  Int where
    cast :: Int64 -> Int
cast (I64# Int#
i) = Int# -> Int
I# Int#
i

instance Cast Int    Word64 where
    cast :: Int -> Word64
cast (I# Int#
i) = Word# -> Word64
W64# (Int# -> Word#
int2Word# Int#
i)
instance Cast Word64 Int where
    cast :: Word64 -> Int
cast (W64# Word#
w) = Int# -> Int
I# (Word# -> Int#
word2Int# Word#
w)
#endif
#else
instance Cast Word   Word32 where
    cast (W# w) = W32# (wordToWord32# w)
instance Cast Word32 Word where
    cast (W32# w) = W# (word32ToWord# w)

instance Cast Word   Int32 where
    cast (W# w) = I32# (intToInt32# (word2Int# w))
instance Cast Int32  Word where
    cast (I32# i) = W# (int2Word# (int32ToInt# i))

instance Cast Int    Int32 where
    cast (I# i) = I32# (intToInt32# i)
instance Cast Int32  Int where
    cast (I32# i) = I# (int32ToInt# i)

instance Cast Int    Word32 where
    cast (I# i) = W32# (wordToWord32# (int2Word# i))
instance Cast Word32 Int where
    cast (W32# w) = I# (word2Int# (word32ToWord# w))
#endif

instance Cast (Block.Block a) (Block.Block Word8) where
    cast :: Block a -> Block Word8
cast (Block.Block ByteArray#
ba) = forall ty. ByteArray# -> Block ty
Block.Block ByteArray#
ba