module Hydra.Dsl.Lib.Literals where

import Hydra.Phantoms
import Hydra.Sources.Libraries
import qualified Hydra.Dsl.Terms as Terms

import Data.Int


bigfloatToBigint :: Datum (Double -> Double)
bigfloatToBigint :: Datum (Double -> Double)
bigfloatToBigint = Term -> Datum (Double -> Double)
forall a. Term -> Datum a
Datum (Term -> Datum (Double -> Double))
-> Term -> Datum (Double -> Double)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigfloatToBigint

bigfloatToFloat32 :: Datum (Double -> Float)
bigfloatToFloat32 :: Datum (Double -> Float)
bigfloatToFloat32 = Term -> Datum (Double -> Float)
forall a. Term -> Datum a
Datum (Term -> Datum (Double -> Float))
-> Term -> Datum (Double -> Float)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigfloatToFloat32

bigfloatToFloat64 :: Datum (Double -> Double)
bigfloatToFloat64 :: Datum (Double -> Double)
bigfloatToFloat64 = Term -> Datum (Double -> Double)
forall a. Term -> Datum a
Datum (Term -> Datum (Double -> Double))
-> Term -> Datum (Double -> Double)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigfloatToFloat64

bigintToBigfloat :: Datum (Integer -> Double)
bigintToBigfloat :: Datum (Integer -> Double)
bigintToBigfloat = Term -> Datum (Integer -> Double)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Double))
-> Term -> Datum (Integer -> Double)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToBigfloat

bigintToInt8 :: Datum (Integer -> Int8)
bigintToInt8 :: Datum (Integer -> Int8)
bigintToInt8 = Term -> Datum (Integer -> Int8)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Int8))
-> Term -> Datum (Integer -> Int8)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToInt8

bigintToInt16 :: Datum (Integer -> Int16)
bigintToInt16 :: Datum (Integer -> Int16)
bigintToInt16 = Term -> Datum (Integer -> Int16)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Int16))
-> Term -> Datum (Integer -> Int16)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToInt16

bigintToInt32 :: Datum (Integer -> Int)
bigintToInt32 :: Datum (Integer -> Int)
bigintToInt32 = Term -> Datum (Integer -> Int)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Int)) -> Term -> Datum (Integer -> Int)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToInt32

bigintToInt64 :: Datum (Integer -> Int64)
bigintToInt64 :: Datum (Integer -> Int64)
bigintToInt64 = Term -> Datum (Integer -> Int64)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Int64))
-> Term -> Datum (Integer -> Int64)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToInt64

bigintToUint8 :: Datum (Integer -> Int16)
bigintToUint8 :: Datum (Integer -> Int16)
bigintToUint8 = Term -> Datum (Integer -> Int16)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Int16))
-> Term -> Datum (Integer -> Int16)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToUint8

bigintToUint16 :: Datum (Integer -> Int)
bigintToUint16 :: Datum (Integer -> Int)
bigintToUint16 = Term -> Datum (Integer -> Int)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Int)) -> Term -> Datum (Integer -> Int)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToUint16

bigintToUint32 :: Datum (Integer -> Int64)
bigintToUint32 :: Datum (Integer -> Int64)
bigintToUint32 = Term -> Datum (Integer -> Int64)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Int64))
-> Term -> Datum (Integer -> Int64)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToUint32

bigintToUint64 :: Datum (Integer -> Integer)
bigintToUint64 :: Datum (Integer -> Integer)
bigintToUint64 = Term -> Datum (Integer -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Integer))
-> Term -> Datum (Integer -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_bigintToUint64

float32ToBigfloat :: Datum (Float -> Double)
float32ToBigfloat :: Datum (Float -> Double)
float32ToBigfloat = Term -> Datum (Float -> Double)
forall a. Term -> Datum a
Datum (Term -> Datum (Float -> Double))
-> Term -> Datum (Float -> Double)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_float32ToBigfloat

float64ToBigfloat :: Datum (Double -> Double)
float64ToBigfloat :: Datum (Double -> Double)
float64ToBigfloat = Term -> Datum (Double -> Double)
forall a. Term -> Datum a
Datum (Term -> Datum (Double -> Double))
-> Term -> Datum (Double -> Double)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_float64ToBigfloat

int8ToBigint :: Datum (Int8 -> Integer)
int8ToBigint :: Datum (Int8 -> Integer)
int8ToBigint = Term -> Datum (Int8 -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Int8 -> Integer))
-> Term -> Datum (Int8 -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_int8ToBigint

int16ToBigint :: Datum (Int16 -> Integer)
int16ToBigint :: Datum (Int16 -> Integer)
int16ToBigint = Term -> Datum (Int16 -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Int16 -> Integer))
-> Term -> Datum (Int16 -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_int16ToBigint

int32ToBigint :: Datum (Int -> Integer)
int32ToBigint :: Datum (Int -> Integer)
int32ToBigint = Term -> Datum (Int -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Int -> Integer)) -> Term -> Datum (Int -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_int32ToBigint

int64ToBigint :: Datum (Int64 -> Integer)
int64ToBigint :: Datum (Int64 -> Integer)
int64ToBigint = Term -> Datum (Int64 -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Int64 -> Integer))
-> Term -> Datum (Int64 -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_int64ToBigint

showInt32 :: Datum (Int -> String)
showInt32 :: Datum (Int -> String)
showInt32 = Term -> Datum (Int -> String)
forall a. Term -> Datum a
Datum (Term -> Datum (Int -> String)) -> Term -> Datum (Int -> String)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_showInt32

showString :: Datum (String -> String)
showString :: Datum (String -> String)
showString = Term -> Datum (String -> String)
forall a. Term -> Datum a
Datum (Term -> Datum (String -> String))
-> Term -> Datum (String -> String)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_showString

uint8ToBigint :: Datum (Int16 -> Integer)
uint8ToBigint :: Datum (Int16 -> Integer)
uint8ToBigint = Term -> Datum (Int16 -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Int16 -> Integer))
-> Term -> Datum (Int16 -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_uint8ToBigint

uint16ToBigint :: Datum (Int -> Integer)
uint16ToBigint :: Datum (Int -> Integer)
uint16ToBigint = Term -> Datum (Int -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Int -> Integer)) -> Term -> Datum (Int -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_uint16ToBigint

uint32ToBigint :: Datum (Int64 -> Integer)
uint32ToBigint :: Datum (Int64 -> Integer)
uint32ToBigint = Term -> Datum (Int64 -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Int64 -> Integer))
-> Term -> Datum (Int64 -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_uint32ToBigint

uint64ToBigint :: Datum (Integer -> Integer)
uint64ToBigint :: Datum (Integer -> Integer)
uint64ToBigint = Term -> Datum (Integer -> Integer)
forall a. Term -> Datum a
Datum (Term -> Datum (Integer -> Integer))
-> Term -> Datum (Integer -> Integer)
forall a b. (a -> b) -> a -> b
$ Name -> Term
Terms.primitive Name
_literals_uint64ToBigint