-- | Possibly convenient facilities for constructing constants.
module Futhark.IR.Prop.Constants
       (
         IsValue (..)
       , constant
       , intConst
       , floatConst
       )
       where

import Futhark.IR.Syntax.Core

-- | If a Haskell type is an instance of 'IsValue', it means that a
-- value of that type can be converted to a Futhark 'PrimValue'.
-- This is intended to cut down on boilerplate when writing compiler
-- code - for example, you'll quickly grow tired of writing @Constant
-- (LogVal True) loc@.
class IsValue a where
  value :: a -> PrimValue

instance IsValue Int where
  value :: Int -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int -> IntValue) -> Int -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int -> Int32) -> Int -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsValue Int8 where
  value :: Int8 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value

instance IsValue Int16 where
  value :: Int16 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value

instance IsValue Int32 where
  value :: Int32 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value

instance IsValue Int64 where
  value :: Int64 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value

instance IsValue Word8 where
  value :: Word8 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Word8 -> IntValue) -> Word8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value (Int8 -> IntValue) -> (Word8 -> Int8) -> Word8 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsValue Word16 where
  value :: Word16 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Word16 -> IntValue) -> Word16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value (Int16 -> IntValue) -> (Word16 -> Int16) -> Word16 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsValue Word32 where
  value :: Word32 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Word32 -> IntValue) -> Word32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Word32 -> Int32) -> Word32 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsValue Word64 where
  value :: Word64 -> PrimValue
value = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Word64 -> IntValue) -> Word64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value (Int64 -> IntValue) -> (Word64 -> Int64) -> Word64 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsValue Double where
  value :: Double -> PrimValue
value = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Double -> FloatValue) -> Double -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FloatValue
Float64Value

instance IsValue Float where
  value :: Float -> PrimValue
value = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Float -> FloatValue) -> Float -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> FloatValue
Float32Value

instance IsValue Bool where
  value :: Bool -> PrimValue
value = Bool -> PrimValue
BoolValue

instance IsValue PrimValue where
  value :: PrimValue -> PrimValue
value = PrimValue -> PrimValue
forall a. a -> a
id

instance IsValue IntValue where
  value :: IntValue -> PrimValue
value = IntValue -> PrimValue
IntValue

instance IsValue FloatValue where
  value :: FloatValue -> PrimValue
value = FloatValue -> PrimValue
FloatValue

-- | Create a 'Constant' 'SubExp' containing the given value.
constant :: IsValue v => v -> SubExp
constant :: v -> SubExp
constant = PrimValue -> SubExp
Constant (PrimValue -> SubExp) -> (v -> PrimValue) -> v -> SubExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> PrimValue
forall a. IsValue a => a -> PrimValue
value

-- | Utility definition for reasons of type ambiguity.
intConst :: IntType -> Integer -> SubExp
intConst :: IntType -> Integer -> SubExp
intConst IntType
t Integer
v = IntValue -> SubExp
forall v. IsValue v => v -> SubExp
constant (IntValue -> SubExp) -> IntValue -> SubExp
forall a b. (a -> b) -> a -> b
$ IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t Integer
v

-- | Utility definition for reasons of type ambiguity.
floatConst :: FloatType -> Double -> SubExp
floatConst :: FloatType -> Double -> SubExp
floatConst FloatType
t Double
v = FloatValue -> SubExp
forall v. IsValue v => v -> SubExp
constant (FloatValue -> SubExp) -> FloatValue -> SubExp
forall a b. (a -> b) -> a -> b
$ FloatType -> Double -> FloatValue
forall num. Real num => FloatType -> num -> FloatValue
floatValue FloatType
t Double
v