{-# Language CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Basement.Compat.NumLiteral
( Integral(..)
, Fractional(..)
, HasNegation(..)
) where
import Prelude (Int, Integer, Rational, Float, Double)
import Data.Word (Word8, Word16, Word32, Word64, Word)
import Data.Int (Int8, Int16, Int32, Int64)
import Basement.Compat.C.Types
import qualified Prelude
import Basement.Compat.Natural
import Foreign.Ptr (IntPtr)
class Integral a where
fromInteger :: Integer -> a
class Fractional a where
fromRational :: Rational -> a
class HasNegation a where
negate :: a -> a
instance Integral Integer where
fromInteger :: Integer -> Integer
fromInteger Integer
a = Integer
a
instance Integral Natural where
fromInteger :: Integer -> Natural
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Int where
fromInteger :: Integer -> Int
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Word where
fromInteger :: Integer -> Word
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Word8 where
fromInteger :: Integer -> Word8
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Word16 where
fromInteger :: Integer -> Word16
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Word32 where
fromInteger :: Integer -> Word32
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Word64 where
fromInteger :: Integer -> Word64
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Int8 where
fromInteger :: Integer -> Int8
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Int16 where
fromInteger :: Integer -> Int16
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Int32 where
fromInteger :: Integer -> Int32
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Int64 where
fromInteger :: Integer -> Int64
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral IntPtr where
fromInteger :: Integer -> IntPtr
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Float where
fromInteger :: Integer -> Float
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral Double where
fromInteger :: Integer -> Double
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CChar where
fromInteger :: Integer -> CChar
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CSChar where
fromInteger :: Integer -> CSChar
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CUChar where
fromInteger :: Integer -> CUChar
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CShort where
fromInteger :: Integer -> CShort
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CUShort where
fromInteger :: Integer -> CUShort
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CInt where
fromInteger :: Integer -> CInt
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CUInt where
fromInteger :: Integer -> CUInt
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CLong where
fromInteger :: Integer -> CLong
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CULong where
fromInteger :: Integer -> CULong
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CPtrdiff where
fromInteger :: Integer -> CPtrdiff
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CSize where
fromInteger :: Integer -> CSize
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CWchar where
fromInteger :: Integer -> CWchar
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CSigAtomic where
fromInteger :: Integer -> CSigAtomic
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CLLong where
fromInteger :: Integer -> CLLong
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CULLong where
fromInteger :: Integer -> CULLong
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
#if MIN_VERSION_base(4, 10, 0)
instance Integral CBool where
fromInteger :: Integer -> CBool
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
#endif
instance Integral CIntPtr where
fromInteger :: Integer -> CIntPtr
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CUIntPtr where
fromInteger :: Integer -> CUIntPtr
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CIntMax where
fromInteger :: Integer -> CIntMax
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CUIntMax where
fromInteger :: Integer -> CUIntMax
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CClock where
fromInteger :: Integer -> CClock
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CTime where
fromInteger :: Integer -> CTime
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CUSeconds where
fromInteger :: Integer -> CUSeconds
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CSUSeconds where
fromInteger :: Integer -> CSUSeconds
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral COff where
fromInteger :: Integer -> COff
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CFloat where
fromInteger :: Integer -> CFloat
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance Integral CDouble where
fromInteger :: Integer -> CDouble
fromInteger Integer
a = forall a. Num a => Integer -> a
Prelude.fromInteger Integer
a
instance HasNegation Integer where
negate :: Integer -> Integer
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Int where
negate :: Int -> Int
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Int8 where
negate :: Int8 -> Int8
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Int16 where
negate :: Int16 -> Int16
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Int32 where
negate :: Int32 -> Int32
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Int64 where
negate :: Int64 -> Int64
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Word where
negate :: Word -> Word
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Word8 where
negate :: Word8 -> Word8
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Word16 where
negate :: Word16 -> Word16
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Word32 where
negate :: Word32 -> Word32
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Word64 where
negate :: Word64 -> Word64
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Float where
negate :: Float -> Float
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation Double where
negate :: Double -> Double
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CChar where
negate :: CChar -> CChar
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CSChar where
negate :: CSChar -> CSChar
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CShort where
negate :: CShort -> CShort
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CInt where
negate :: CInt -> CInt
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CLong where
negate :: CLong -> CLong
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CPtrdiff where
negate :: CPtrdiff -> CPtrdiff
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CWchar where
negate :: CWchar -> CWchar
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CLLong where
negate :: CLLong -> CLLong
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CIntMax where
negate :: CIntMax -> CIntMax
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CFloat where
negate :: CFloat -> CFloat
negate = forall a. Num a => a -> a
Prelude.negate
instance HasNegation CDouble where
negate :: CDouble -> CDouble
negate = forall a. Num a => a -> a
Prelude.negate
instance Fractional Rational where
fromRational :: Rational -> Rational
fromRational Rational
a = forall a. Fractional a => Rational -> a
Prelude.fromRational Rational
a
instance Fractional Float where
fromRational :: Rational -> Float
fromRational Rational
a = forall a. Fractional a => Rational -> a
Prelude.fromRational Rational
a
instance Fractional Double where
fromRational :: Rational -> Double
fromRational Rational
a = forall a. Fractional a => Rational -> a
Prelude.fromRational Rational
a
instance Fractional CFloat where
fromRational :: Rational -> CFloat
fromRational Rational
a = forall a. Fractional a => Rational -> a
Prelude.fromRational Rational
a
instance Fractional CDouble where
fromRational :: Rational -> CDouble
fromRational Rational
a = forall a. Fractional a => Rational -> a
Prelude.fromRational Rational
a