-- | Haskell implementations of hydra/lib/literals primitives

module Hydra.Lib.Literals where

import Data.Int


bigfloatToBigint :: Double -> Integer
bigfloatToBigint :: Double -> Integer
bigfloatToBigint = Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round

bigfloatToFloat32 :: Double -> Float
bigfloatToFloat32 :: Double -> Float
bigfloatToFloat32 = Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

bigfloatToFloat64 :: Double -> Double
bigfloatToFloat64 :: Double -> Double
bigfloatToFloat64 = Double -> Double
forall a. a -> a
id

bigintToBigfloat :: Integer -> Double
bigintToBigfloat :: Integer -> Double
bigintToBigfloat = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToInt8 :: Integer -> Int8
bigintToInt8 :: Integer -> Int8
bigintToInt8 = Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToInt16 :: Integer -> Int16
bigintToInt16 :: Integer -> Int16
bigintToInt16 = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToInt32 :: Integer -> Int
bigintToInt32 :: Integer -> Int
bigintToInt32 = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToInt64 :: Integer -> Int64
bigintToInt64 :: Integer -> Int64
bigintToInt64 = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToUint8 :: Integer -> Int16
bigintToUint8 :: Integer -> Int16
bigintToUint8 = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToUint16 :: Integer -> Int
bigintToUint16 :: Integer -> Int
bigintToUint16 = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToUint32 :: Integer -> Int64
bigintToUint32 :: Integer -> Int64
bigintToUint32 = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

bigintToUint64 :: Integer -> Integer
bigintToUint64 :: Integer -> Integer
bigintToUint64 = Integer -> Integer
forall a. a -> a
id

float32ToBigfloat :: Float -> Double
float32ToBigfloat :: Float -> Double
float32ToBigfloat = Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

float64ToBigfloat :: Double -> Double
float64ToBigfloat :: Double -> Double
float64ToBigfloat = Double -> Double
forall a. a -> a
id

int8ToBigint :: Int8 -> Integer
int8ToBigint :: Int8 -> Integer
int8ToBigint = Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

int16ToBigint :: Int16 -> Integer
int16ToBigint :: Int16 -> Integer
int16ToBigint = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

int32ToBigint :: Int -> Integer
int32ToBigint :: Int -> Integer
int32ToBigint = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

int64ToBigint :: Int64 -> Integer
int64ToBigint :: Int64 -> Integer
int64ToBigint = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

showInt32 :: Int -> String
showInt32 :: Int -> String
showInt32 = Int -> String
forall a. Show a => a -> String
show

showString :: String -> String
showString :: String -> String
showString = String -> String
forall a. Show a => a -> String
show

uint8ToBigint :: Int16 -> Integer
uint8ToBigint :: Int16 -> Integer
uint8ToBigint = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

uint16ToBigint :: Int -> Integer
uint16ToBigint :: Int -> Integer
uint16ToBigint = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

uint32ToBigint :: Int64 -> Integer
uint32ToBigint :: Int64 -> Integer
uint32ToBigint = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

uint64ToBigint :: Integer -> Integer
uint64ToBigint :: Integer -> Integer
uint64ToBigint = Integer -> Integer
forall a. a -> a
id