-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe                  #-}

-- | Type-safe casting operators.
module Copilot.Language.Operators.Cast
  ( cast, unsafeCast, Cast, UnsafeCast ) where

import qualified Copilot.Core.Operators as C
import Copilot.Core.Type
import Copilot.Language.Stream

import Data.Int
import Data.Word

-- | Class to capture casting between types for which it can be performed
-- safely.
class Cast a b where
  -- | Perform a safe cast from @Stream a@ to @Stream b@.
  cast :: (Typed a, Typed b) => Stream a -> Stream b

-- | Class to capture casting between types for which casting may be unsafe
-- and/or result in a loss of precision or information.
class UnsafeCast a b where
  -- | Perform an unsafe cast from @Stream a@ to @Stream b@.
  unsafeCast :: (Typed a, Typed b) => Stream a -> Stream b

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
castBool :: (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool :: forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool (Const Bool
bool) = forall a. Typed a => a -> Stream a
Const forall a b. (a -> b) -> a -> b
$ if Bool
bool then a
1 else a
0
castBool Stream Bool
x            = forall a b c d.
(Typed a, Typed b, Typed c, Typed d) =>
Op3 a b c d -> Stream a -> Stream b -> Stream c -> Stream d
Op3 (forall b. Type b -> Op3 Bool b b b
C.Mux forall a. Typed a => Type a
typeOf) Stream Bool
x Stream a
1 Stream a
0

-- | Identity casting.
instance Cast Bool Bool where
  cast :: (Typed Bool, Typed Bool) => Stream Bool -> Stream Bool
cast = forall a. a -> a
id

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Word8 where
  cast :: (Typed Bool, Typed Word8) => Stream Bool -> Stream Word8
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Word16 where
  cast :: (Typed Bool, Typed Word16) => Stream Bool -> Stream Word16
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Word32 where
  cast :: (Typed Bool, Typed Word32) => Stream Bool -> Stream Word32
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Word64 where
  cast :: (Typed Bool, Typed Word64) => Stream Bool -> Stream Word64
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Int8 where
  cast :: (Typed Bool, Typed Int8) => Stream Bool -> Stream Int8
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Int16 where
  cast :: (Typed Bool, Typed Int16) => Stream Bool -> Stream Int16
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Int32 where
  cast :: (Typed Bool, Typed Int32) => Stream Bool -> Stream Int32
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a boolean stream to a stream of numbers, producing 1 if the
-- value at a point in time is 'True', and 0 otherwise.
instance Cast Bool Int64 where
  cast :: (Typed Bool, Typed Int64) => Stream Bool -> Stream Int64
cast = forall a. (Eq a, Num a, Typed a) => Stream Bool -> Stream a
castBool

-- | Cast a stream carrying numbers to an integral using 'fromIntegral'.
castIntegral :: (Integral a, Typed a, Num b, Typed b) => Stream a -> Stream b
castIntegral :: forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral (Const a
x) = forall a. Typed a => a -> Stream a
Const (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
castIntegral Stream a
x         = forall a b. (Typed a, Typed b) => Op1 a b -> Stream a -> Stream b
Op1 (forall a b. (Integral a, Num b) => Type a -> Type b -> Op1 a b
C.Cast forall a. Typed a => Type a
typeOf forall a. Typed a => Type a
typeOf) Stream a
x

-- | Identity casting.
instance Cast Word8 Word8 where
  cast :: (Typed Word8, Typed Word8) => Stream Word8 -> Stream Word8
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word8 Word16 where
  cast :: (Typed Word8, Typed Word16) => Stream Word8 -> Stream Word16
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word8 Word32 where
  cast :: (Typed Word8, Typed Word32) => Stream Word8 -> Stream Word32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word8 Word64 where
  cast :: (Typed Word8, Typed Word64) => Stream Word8 -> Stream Word64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word8 Int16 where
  cast :: (Typed Word8, Typed Int16) => Stream Word8 -> Stream Int16
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word8 Int32 where
  cast :: (Typed Word8, Typed Int32) => Stream Word8 -> Stream Int32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word8 Int64 where
  cast :: (Typed Word8, Typed Int64) => Stream Word8 -> Stream Int64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Identity casting.
instance Cast Word16 Word16 where
  cast :: (Typed Word16, Typed Word16) => Stream Word16 -> Stream Word16
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word16 Word32 where
  cast :: (Typed Word16, Typed Word32) => Stream Word16 -> Stream Word32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word16 Word64 where
  cast :: (Typed Word16, Typed Word64) => Stream Word16 -> Stream Word64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word16 Int32 where
  cast :: (Typed Word16, Typed Int32) => Stream Word16 -> Stream Int32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word16 Int64 where
  cast :: (Typed Word16, Typed Int64) => Stream Word16 -> Stream Int64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Identity casting.
instance Cast Word32 Word32 where
  cast :: (Typed Word32, Typed Word32) => Stream Word32 -> Stream Word32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word32 Word64 where
  cast :: (Typed Word32, Typed Word64) => Stream Word32 -> Stream Word64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Word32 Int64 where
  cast :: (Typed Word32, Typed Int64) => Stream Word32 -> Stream Int64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Identity casting.
instance Cast Word64 Word64 where
  cast :: (Typed Word64, Typed Word64) => Stream Word64 -> Stream Word64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Identity casting.
instance Cast Int8 Int8 where
  cast :: (Typed Int8, Typed Int8) => Stream Int8 -> Stream Int8
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Int8 Int16 where
  cast :: (Typed Int8, Typed Int16) => Stream Int8 -> Stream Int16
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Int8 Int32 where
  cast :: (Typed Int8, Typed Int32) => Stream Int8 -> Stream Int32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Int8 Int64 where
  cast :: (Typed Int8, Typed Int64) => Stream Int8 -> Stream Int64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Identity casting.
instance Cast Int16 Int16 where
  cast :: (Typed Int16, Typed Int16) => Stream Int16 -> Stream Int16
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Int16 Int32 where
  cast :: (Typed Int16, Typed Int32) => Stream Int16 -> Stream Int32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Int16 Int64 where
  cast :: (Typed Int16, Typed Int64) => Stream Int16 -> Stream Int64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Identity casting.
instance Cast Int32 Int32 where
  cast :: (Typed Int32, Typed Int32) => Stream Int32 -> Stream Int32
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast number to bigger type.
instance Cast Int32 Int64 where
  cast :: (Typed Int32, Typed Int64) => Stream Int32 -> Stream Int64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Identity casting.
instance Cast Int64 Int64 where
  cast :: (Typed Int64, Typed Int64) => Stream Int64 -> Stream Int64
cast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Word64 Word32 where
  unsafeCast :: (Typed Word64, Typed Word32) => Stream Word64 -> Stream Word32
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Word64 Word16 where
  unsafeCast :: (Typed Word64, Typed Word16) => Stream Word64 -> Stream Word16
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Word64 Word8 where
  unsafeCast :: (Typed Word64, Typed Word8) => Stream Word64 -> Stream Word8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Word32 Word16 where
  unsafeCast :: (Typed Word32, Typed Word16) => Stream Word32 -> Stream Word16
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Word32 Word8 where
  unsafeCast :: (Typed Word32, Typed Word8) => Stream Word32 -> Stream Word8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Word16 Word8 where
  unsafeCast :: (Typed Word16, Typed Word8) => Stream Word16 -> Stream Word8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Int64 Int32 where
  unsafeCast :: (Typed Int64, Typed Int32) => Stream Int64 -> Stream Int32
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Int64 Int16 where
  unsafeCast :: (Typed Int64, Typed Int16) => Stream Int64 -> Stream Int16
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Int64 Int8 where
  unsafeCast :: (Typed Int64, Typed Int8) => Stream Int64 -> Stream Int8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Int32 Int16 where
  unsafeCast :: (Typed Int32, Typed Int16) => Stream Int32 -> Stream Int16
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Int32 Int8 where
  unsafeCast :: (Typed Int32, Typed Int8) => Stream Int32 -> Stream Int8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe downcasting to smaller sizes.
instance UnsafeCast Int16 Int8 where
  unsafeCast :: (Typed Int16, Typed Int8) => Stream Int16 -> Stream Int8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int64 Float where
  unsafeCast :: (Typed Int64, Typed Float) => Stream Int64 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int32 Float where
  unsafeCast :: (Typed Int32, Typed Float) => Stream Int32 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int16 Float where
  unsafeCast :: (Typed Int16, Typed Float) => Stream Int16 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int8 Float where
  unsafeCast :: (Typed Int8, Typed Float) => Stream Int8 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int64 Double where
  unsafeCast :: (Typed Int64, Typed Double) => Stream Int64 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int32 Double where
  unsafeCast :: (Typed Int32, Typed Double) => Stream Int32 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int16 Double where
  unsafeCast :: (Typed Int16, Typed Double) => Stream Int16 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe signed integer promotion to floating point values.
instance UnsafeCast Int8 Double where
  unsafeCast :: (Typed Int8, Typed Double) => Stream Int8 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word64 Float where
  unsafeCast :: (Typed Word64, Typed Float) => Stream Word64 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word32 Float where
  unsafeCast :: (Typed Word32, Typed Float) => Stream Word32 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word16 Float where
  unsafeCast :: (Typed Word16, Typed Float) => Stream Word16 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word8 Float where
  unsafeCast :: (Typed Word8, Typed Float) => Stream Word8 -> Stream Float
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word64 Double where
  unsafeCast :: (Typed Word64, Typed Double) => Stream Word64 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word32 Double where
  unsafeCast :: (Typed Word32, Typed Double) => Stream Word32 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word16 Double where
  unsafeCast :: (Typed Word16, Typed Double) => Stream Word16 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Unsafe unsigned integer promotion to floating point values.
instance UnsafeCast Word8 Double where
  unsafeCast :: (Typed Word8, Typed Double) => Stream Word8 -> Stream Double
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast from unsigned numbers to signed numbers.
instance UnsafeCast Word64 Int64 where
  unsafeCast :: (Typed Word64, Typed Int64) => Stream Word64 -> Stream Int64
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast from unsigned numbers to signed numbers.
instance UnsafeCast Word32 Int32 where
  unsafeCast :: (Typed Word32, Typed Int32) => Stream Word32 -> Stream Int32
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast from unsigned numbers to signed numbers.
instance UnsafeCast Word16 Int16 where
  unsafeCast :: (Typed Word16, Typed Int16) => Stream Word16 -> Stream Int16
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Cast from unsigned numbers to signed numbers.
instance UnsafeCast Word8 Int8 where
  unsafeCast :: (Typed Word8, Typed Int8) => Stream Word8 -> Stream Int8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Signed to unsigned casting.
instance UnsafeCast Int64 Word64 where
  unsafeCast :: (Typed Int64, Typed Word64) => Stream Int64 -> Stream Word64
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Signed to unsigned casting.
instance UnsafeCast Int32 Word32 where
  unsafeCast :: (Typed Int32, Typed Word32) => Stream Int32 -> Stream Word32
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Signed to unsigned casting.
instance UnsafeCast Int16 Word16 where
  unsafeCast :: (Typed Int16, Typed Word16) => Stream Int16 -> Stream Word16
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral

-- | Signed to unsigned casting.
instance UnsafeCast Int8 Word8 where
  unsafeCast :: (Typed Int8, Typed Word8) => Stream Int8 -> Stream Word8
unsafeCast = forall a b.
(Integral a, Typed a, Num b, Typed b) =>
Stream a -> Stream b
castIntegral