{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- |
-- 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.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 s. ST s destination) -> destination
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s destination) -> destination)
-> (forall s. ST s destination) -> destination
forall a b. (a -> b) -> a -> b
$ do
        MutableBlock source s
mba <- CountOf source -> ST s (MutableBlock source (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.new CountOf source
1
        MutableBlock source (PrimState (ST s))
-> Offset source -> source -> ST s ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
Block.unsafeWrite MutableBlock source s
MutableBlock source (PrimState (ST s))
mba Offset source
0 source
a
        MutableBlock destination (PrimState (ST s))
-> Offset destination -> ST s destination
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
Block.unsafeRead (MutableBlock source s -> MutableBlock destination s
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# Int#
i) = Word# -> Word8
W8# (Word# -> Word#
narrow8Word# (Int# -> Word#
int2Word# Int#
i))
instance Cast Int16 Word16 where
    cast :: Int16 -> Word16
cast (I16# Int#
i) = Word# -> Word16
W16# (Word# -> Word#
narrow16Word# (Int# -> Word#
int2Word# Int#
i))
instance Cast Int32 Word32 where
    cast :: Int32 -> Word32
cast (I32# Int#
i) = Word# -> Word32
W32# (Word# -> Word#
narrow32Word# (Int# -> Word#
int2Word# Int#
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# Word#
i) = Int# -> Int8
I8# (Int# -> Int#
narrow8Int# (Word# -> Int#
word2Int# Word#
i))
instance Cast Word16 Int16 where
    cast :: Word16 -> Int16
cast (W16# Word#
i) = Int# -> Int16
I16# (Int# -> Int#
narrow16Int# (Word# -> Int#
word2Int# Word#
i))
instance Cast Word32 Int32 where
    cast :: Word32 -> Int32
cast (W32# Word#
i) = Int# -> Int32
I32# (Int# -> Int#
narrow32Int# (Word# -> Int#
word2Int# Word#
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
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)
#else
instance Cast Word   Word32 where
    cast (W# w) = W32# w
instance Cast Word32 Word where
    cast (W32# w) = W# w

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

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

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

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