{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE UnboxedSums                #-}
{-# LANGUAGE UnboxedTuples              #-}
module Numeric.DataFrame.Internal.Backend.Family.ScalarBase (ScalarBase (..)) where


import           Data.Coerce
import           Numeric.Basics
import           Numeric.DataFrame.Internal.PrimArray
import           Numeric.PrimBytes
import           Numeric.ProductOrd
import qualified Numeric.ProductOrd.NonTransitive     as NonTransitive
import qualified Numeric.ProductOrd.Partial           as Partial

-- | Specialize ScalarBase type without any arrays
newtype ScalarBase t = ScalarBase { ScalarBase t -> t
_unScalarBase :: t }
  deriving ( Int -> ScalarBase t
ScalarBase t -> Int
ScalarBase t -> [ScalarBase t]
ScalarBase t -> ScalarBase t
ScalarBase t -> ScalarBase t -> [ScalarBase t]
ScalarBase t -> ScalarBase t -> ScalarBase t -> [ScalarBase t]
(ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (Int -> ScalarBase t)
-> (ScalarBase t -> Int)
-> (ScalarBase t -> [ScalarBase t])
-> (ScalarBase t -> ScalarBase t -> [ScalarBase t])
-> (ScalarBase t -> ScalarBase t -> [ScalarBase t])
-> (ScalarBase t -> ScalarBase t -> ScalarBase t -> [ScalarBase t])
-> Enum (ScalarBase t)
forall t. Enum t => Int -> ScalarBase t
forall t. Enum t => ScalarBase t -> Int
forall t. Enum t => ScalarBase t -> [ScalarBase t]
forall t. Enum t => ScalarBase t -> ScalarBase t
forall t. Enum t => ScalarBase t -> ScalarBase t -> [ScalarBase t]
forall t.
Enum t =>
ScalarBase t -> ScalarBase t -> ScalarBase t -> [ScalarBase t]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ScalarBase t -> ScalarBase t -> ScalarBase t -> [ScalarBase t]
$cenumFromThenTo :: forall t.
Enum t =>
ScalarBase t -> ScalarBase t -> ScalarBase t -> [ScalarBase t]
enumFromTo :: ScalarBase t -> ScalarBase t -> [ScalarBase t]
$cenumFromTo :: forall t. Enum t => ScalarBase t -> ScalarBase t -> [ScalarBase t]
enumFromThen :: ScalarBase t -> ScalarBase t -> [ScalarBase t]
$cenumFromThen :: forall t. Enum t => ScalarBase t -> ScalarBase t -> [ScalarBase t]
enumFrom :: ScalarBase t -> [ScalarBase t]
$cenumFrom :: forall t. Enum t => ScalarBase t -> [ScalarBase t]
fromEnum :: ScalarBase t -> Int
$cfromEnum :: forall t. Enum t => ScalarBase t -> Int
toEnum :: Int -> ScalarBase t
$ctoEnum :: forall t. Enum t => Int -> ScalarBase t
pred :: ScalarBase t -> ScalarBase t
$cpred :: forall t. Enum t => ScalarBase t -> ScalarBase t
succ :: ScalarBase t -> ScalarBase t
$csucc :: forall t. Enum t => ScalarBase t -> ScalarBase t
Enum, ScalarBase t -> ScalarBase t -> Bool
(ScalarBase t -> ScalarBase t -> Bool)
-> (ScalarBase t -> ScalarBase t -> Bool) -> Eq (ScalarBase t)
forall t. Eq t => ScalarBase t -> ScalarBase t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScalarBase t -> ScalarBase t -> Bool
$c/= :: forall t. Eq t => ScalarBase t -> ScalarBase t -> Bool
== :: ScalarBase t -> ScalarBase t -> Bool
$c== :: forall t. Eq t => ScalarBase t -> ScalarBase t -> Bool
Eq, ScalarBase t
ScalarBase t -> ScalarBase t -> Bounded (ScalarBase t)
forall a. a -> a -> Bounded a
forall t. Bounded t => ScalarBase t
maxBound :: ScalarBase t
$cmaxBound :: forall t. Bounded t => ScalarBase t
minBound :: ScalarBase t
$cminBound :: forall t. Bounded t => ScalarBase t
Bounded, Enum (ScalarBase t)
Real (ScalarBase t)
Real (ScalarBase t)
-> Enum (ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t))
-> (ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t))
-> (ScalarBase t -> Integer)
-> Integral (ScalarBase t)
ScalarBase t -> Integer
ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t)
ScalarBase t -> ScalarBase t -> ScalarBase t
forall t. Integral t => Enum (ScalarBase t)
forall t. Integral t => Real (ScalarBase t)
forall t. Integral t => ScalarBase t -> Integer
forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t)
forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ScalarBase t -> Integer
$ctoInteger :: forall t. Integral t => ScalarBase t -> Integer
divMod :: ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t)
$cdivMod :: forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t)
quotRem :: ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t)
$cquotRem :: forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> (ScalarBase t, ScalarBase t)
mod :: ScalarBase t -> ScalarBase t -> ScalarBase t
$cmod :: forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
div :: ScalarBase t -> ScalarBase t -> ScalarBase t
$cdiv :: forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
rem :: ScalarBase t -> ScalarBase t -> ScalarBase t
$crem :: forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
quot :: ScalarBase t -> ScalarBase t -> ScalarBase t
$cquot :: forall t.
Integral t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
$cp2Integral :: forall t. Integral t => Enum (ScalarBase t)
$cp1Integral :: forall t. Integral t => Real (ScalarBase t)
Integral, Eq (ScalarBase t)
Floating (ScalarBase t)
ScalarBase t
Eq (ScalarBase t)
-> Floating (ScalarBase t)
-> ScalarBase t
-> Epsilon (ScalarBase t)
forall a. Eq a -> Floating a -> a -> Epsilon a
forall t. Epsilon t => Eq (ScalarBase t)
forall t. Epsilon t => Floating (ScalarBase t)
forall t. Epsilon t => ScalarBase t
epsilon :: ScalarBase t
$cepsilon :: forall t. Epsilon t => ScalarBase t
$cp2Epsilon :: forall t. Epsilon t => Floating (ScalarBase t)
$cp1Epsilon :: forall t. Epsilon t => Eq (ScalarBase t)
Epsilon, Real (ScalarBase t)
PrimBytes (ScalarBase t)
Real (ScalarBase t)
-> PrimBytes (ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> RealExtras (ScalarBase t)
ScalarBase t -> ScalarBase t -> ScalarBase t
forall a. Real a -> PrimBytes a -> (a -> a -> a) -> RealExtras a
forall t. RealExtras t => Real (ScalarBase t)
forall t. RealExtras t => PrimBytes (ScalarBase t)
forall t.
RealExtras t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
copysign :: ScalarBase t -> ScalarBase t -> ScalarBase t
$ccopysign :: forall t.
RealExtras t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
$cp2RealExtras :: forall t. RealExtras t => PrimBytes (ScalarBase t)
$cp1RealExtras :: forall t. RealExtras t => Real (ScalarBase t)
RealExtras, RealFloat (ScalarBase t)
RealExtras (ScalarBase t)
Epsilon (ScalarBase t)
ScalarBase t
Epsilon (ScalarBase t)
-> RealExtras (ScalarBase t)
-> RealFloat (ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> ScalarBase t
-> RealFloatExtras (ScalarBase t)
ScalarBase t -> ScalarBase t -> ScalarBase t
forall t. RealFloatExtras t => RealFloat (ScalarBase t)
forall t. RealFloatExtras t => RealExtras (ScalarBase t)
forall t. RealFloatExtras t => Epsilon (ScalarBase t)
forall t. RealFloatExtras t => ScalarBase t
forall t.
RealFloatExtras t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
forall a.
Epsilon a
-> RealExtras a
-> RealFloat a
-> (a -> a -> a)
-> a
-> RealFloatExtras a
maxFinite :: ScalarBase t
$cmaxFinite :: forall t. RealFloatExtras t => ScalarBase t
hypot :: ScalarBase t -> ScalarBase t -> ScalarBase t
$chypot :: forall t.
RealFloatExtras t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
$cp3RealFloatExtras :: forall t. RealFloatExtras t => RealFloat (ScalarBase t)
$cp2RealFloatExtras :: forall t. RealFloatExtras t => RealExtras (ScalarBase t)
$cp1RealFloatExtras :: forall t. RealFloatExtras t => Epsilon (ScalarBase t)
RealFloatExtras
           , Integer -> ScalarBase t
ScalarBase t -> ScalarBase t
ScalarBase t -> ScalarBase t -> ScalarBase t
(ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (Integer -> ScalarBase t)
-> Num (ScalarBase t)
forall t. Num t => Integer -> ScalarBase t
forall t. Num t => ScalarBase t -> ScalarBase t
forall t. Num t => ScalarBase t -> ScalarBase t -> ScalarBase t
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ScalarBase t
$cfromInteger :: forall t. Num t => Integer -> ScalarBase t
signum :: ScalarBase t -> ScalarBase t
$csignum :: forall t. Num t => ScalarBase t -> ScalarBase t
abs :: ScalarBase t -> ScalarBase t
$cabs :: forall t. Num t => ScalarBase t -> ScalarBase t
negate :: ScalarBase t -> ScalarBase t
$cnegate :: forall t. Num t => ScalarBase t -> ScalarBase t
* :: ScalarBase t -> ScalarBase t -> ScalarBase t
$c* :: forall t. Num t => ScalarBase t -> ScalarBase t -> ScalarBase t
- :: ScalarBase t -> ScalarBase t -> ScalarBase t
$c- :: forall t. Num t => ScalarBase t -> ScalarBase t -> ScalarBase t
+ :: ScalarBase t -> ScalarBase t -> ScalarBase t
$c+ :: forall t. Num t => ScalarBase t -> ScalarBase t -> ScalarBase t
Num, Num (ScalarBase t)
Num (ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (Rational -> ScalarBase t)
-> Fractional (ScalarBase t)
Rational -> ScalarBase t
ScalarBase t -> ScalarBase t
ScalarBase t -> ScalarBase t -> ScalarBase t
forall t. Fractional t => Num (ScalarBase t)
forall t. Fractional t => Rational -> ScalarBase t
forall t. Fractional t => ScalarBase t -> ScalarBase t
forall t.
Fractional t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> ScalarBase t
$cfromRational :: forall t. Fractional t => Rational -> ScalarBase t
recip :: ScalarBase t -> ScalarBase t
$crecip :: forall t. Fractional t => ScalarBase t -> ScalarBase t
/ :: ScalarBase t -> ScalarBase t -> ScalarBase t
$c/ :: forall t.
Fractional t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
$cp1Fractional :: forall t. Fractional t => Num (ScalarBase t)
Fractional, Fractional (ScalarBase t)
ScalarBase t
Fractional (ScalarBase t)
-> ScalarBase t
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t)
-> Floating (ScalarBase t)
ScalarBase t -> ScalarBase t
ScalarBase t -> ScalarBase t -> ScalarBase t
forall t. Floating t => Fractional (ScalarBase t)
forall t. Floating t => ScalarBase t
forall t. Floating t => ScalarBase t -> ScalarBase t
forall t.
Floating t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
forall a.
Fractional a
-> a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
log1mexp :: ScalarBase t -> ScalarBase t
$clog1mexp :: forall t. Floating t => ScalarBase t -> ScalarBase t
log1pexp :: ScalarBase t -> ScalarBase t
$clog1pexp :: forall t. Floating t => ScalarBase t -> ScalarBase t
expm1 :: ScalarBase t -> ScalarBase t
$cexpm1 :: forall t. Floating t => ScalarBase t -> ScalarBase t
log1p :: ScalarBase t -> ScalarBase t
$clog1p :: forall t. Floating t => ScalarBase t -> ScalarBase t
atanh :: ScalarBase t -> ScalarBase t
$catanh :: forall t. Floating t => ScalarBase t -> ScalarBase t
acosh :: ScalarBase t -> ScalarBase t
$cacosh :: forall t. Floating t => ScalarBase t -> ScalarBase t
asinh :: ScalarBase t -> ScalarBase t
$casinh :: forall t. Floating t => ScalarBase t -> ScalarBase t
tanh :: ScalarBase t -> ScalarBase t
$ctanh :: forall t. Floating t => ScalarBase t -> ScalarBase t
cosh :: ScalarBase t -> ScalarBase t
$ccosh :: forall t. Floating t => ScalarBase t -> ScalarBase t
sinh :: ScalarBase t -> ScalarBase t
$csinh :: forall t. Floating t => ScalarBase t -> ScalarBase t
atan :: ScalarBase t -> ScalarBase t
$catan :: forall t. Floating t => ScalarBase t -> ScalarBase t
acos :: ScalarBase t -> ScalarBase t
$cacos :: forall t. Floating t => ScalarBase t -> ScalarBase t
asin :: ScalarBase t -> ScalarBase t
$casin :: forall t. Floating t => ScalarBase t -> ScalarBase t
tan :: ScalarBase t -> ScalarBase t
$ctan :: forall t. Floating t => ScalarBase t -> ScalarBase t
cos :: ScalarBase t -> ScalarBase t
$ccos :: forall t. Floating t => ScalarBase t -> ScalarBase t
sin :: ScalarBase t -> ScalarBase t
$csin :: forall t. Floating t => ScalarBase t -> ScalarBase t
logBase :: ScalarBase t -> ScalarBase t -> ScalarBase t
$clogBase :: forall t.
Floating t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
** :: ScalarBase t -> ScalarBase t -> ScalarBase t
$c** :: forall t.
Floating t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
sqrt :: ScalarBase t -> ScalarBase t
$csqrt :: forall t. Floating t => ScalarBase t -> ScalarBase t
log :: ScalarBase t -> ScalarBase t
$clog :: forall t. Floating t => ScalarBase t -> ScalarBase t
exp :: ScalarBase t -> ScalarBase t
$cexp :: forall t. Floating t => ScalarBase t -> ScalarBase t
pi :: ScalarBase t
$cpi :: forall t. Floating t => ScalarBase t
$cp1Floating :: forall t. Floating t => Fractional (ScalarBase t)
Floating, Eq (ScalarBase t)
Eq (ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> Ordering)
-> (ScalarBase t -> ScalarBase t -> Bool)
-> (ScalarBase t -> ScalarBase t -> Bool)
-> (ScalarBase t -> ScalarBase t -> Bool)
-> (ScalarBase t -> ScalarBase t -> Bool)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> Ord (ScalarBase t)
ScalarBase t -> ScalarBase t -> Bool
ScalarBase t -> ScalarBase t -> Ordering
ScalarBase t -> ScalarBase t -> ScalarBase t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (ScalarBase t)
forall t. Ord t => ScalarBase t -> ScalarBase t -> Bool
forall t. Ord t => ScalarBase t -> ScalarBase t -> Ordering
forall t. Ord t => ScalarBase t -> ScalarBase t -> ScalarBase t
min :: ScalarBase t -> ScalarBase t -> ScalarBase t
$cmin :: forall t. Ord t => ScalarBase t -> ScalarBase t -> ScalarBase t
max :: ScalarBase t -> ScalarBase t -> ScalarBase t
$cmax :: forall t. Ord t => ScalarBase t -> ScalarBase t -> ScalarBase t
>= :: ScalarBase t -> ScalarBase t -> Bool
$c>= :: forall t. Ord t => ScalarBase t -> ScalarBase t -> Bool
> :: ScalarBase t -> ScalarBase t -> Bool
$c> :: forall t. Ord t => ScalarBase t -> ScalarBase t -> Bool
<= :: ScalarBase t -> ScalarBase t -> Bool
$c<= :: forall t. Ord t => ScalarBase t -> ScalarBase t -> Bool
< :: ScalarBase t -> ScalarBase t -> Bool
$c< :: forall t. Ord t => ScalarBase t -> ScalarBase t -> Bool
compare :: ScalarBase t -> ScalarBase t -> Ordering
$ccompare :: forall t. Ord t => ScalarBase t -> ScalarBase t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (ScalarBase t)
Ord, Num (ScalarBase t)
Ord (ScalarBase t)
Num (ScalarBase t)
-> Ord (ScalarBase t)
-> (ScalarBase t -> Rational)
-> Real (ScalarBase t)
ScalarBase t -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall t. Real t => Num (ScalarBase t)
forall t. Real t => Ord (ScalarBase t)
forall t. Real t => ScalarBase t -> Rational
toRational :: ScalarBase t -> Rational
$ctoRational :: forall t. Real t => ScalarBase t -> Rational
$cp2Real :: forall t. Real t => Ord (ScalarBase t)
$cp1Real :: forall t. Real t => Num (ScalarBase t)
Real, Fractional (ScalarBase t)
Real (ScalarBase t)
Real (ScalarBase t)
-> Fractional (ScalarBase t)
-> (forall b. Integral b => ScalarBase t -> (b, ScalarBase t))
-> (forall b. Integral b => ScalarBase t -> b)
-> (forall b. Integral b => ScalarBase t -> b)
-> (forall b. Integral b => ScalarBase t -> b)
-> (forall b. Integral b => ScalarBase t -> b)
-> RealFrac (ScalarBase t)
ScalarBase t -> b
ScalarBase t -> b
ScalarBase t -> b
ScalarBase t -> b
ScalarBase t -> (b, ScalarBase t)
forall b. Integral b => ScalarBase t -> b
forall b. Integral b => ScalarBase t -> (b, ScalarBase t)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
forall t. RealFrac t => Fractional (ScalarBase t)
forall t. RealFrac t => Real (ScalarBase t)
forall t b. (RealFrac t, Integral b) => ScalarBase t -> b
forall t b.
(RealFrac t, Integral b) =>
ScalarBase t -> (b, ScalarBase t)
floor :: ScalarBase t -> b
$cfloor :: forall t b. (RealFrac t, Integral b) => ScalarBase t -> b
ceiling :: ScalarBase t -> b
$cceiling :: forall t b. (RealFrac t, Integral b) => ScalarBase t -> b
round :: ScalarBase t -> b
$cround :: forall t b. (RealFrac t, Integral b) => ScalarBase t -> b
truncate :: ScalarBase t -> b
$ctruncate :: forall t b. (RealFrac t, Integral b) => ScalarBase t -> b
properFraction :: ScalarBase t -> (b, ScalarBase t)
$cproperFraction :: forall t b.
(RealFrac t, Integral b) =>
ScalarBase t -> (b, ScalarBase t)
$cp2RealFrac :: forall t. RealFrac t => Fractional (ScalarBase t)
$cp1RealFrac :: forall t. RealFrac t => Real (ScalarBase t)
RealFrac, Floating (ScalarBase t)
RealFrac (ScalarBase t)
RealFrac (ScalarBase t)
-> Floating (ScalarBase t)
-> (ScalarBase t -> Integer)
-> (ScalarBase t -> Int)
-> (ScalarBase t -> (Int, Int))
-> (ScalarBase t -> (Integer, Int))
-> (Integer -> Int -> ScalarBase t)
-> (ScalarBase t -> Int)
-> (ScalarBase t -> ScalarBase t)
-> (Int -> ScalarBase t -> ScalarBase t)
-> (ScalarBase t -> Bool)
-> (ScalarBase t -> Bool)
-> (ScalarBase t -> Bool)
-> (ScalarBase t -> Bool)
-> (ScalarBase t -> Bool)
-> (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> RealFloat (ScalarBase t)
Int -> ScalarBase t -> ScalarBase t
Integer -> Int -> ScalarBase t
ScalarBase t -> Bool
ScalarBase t -> Int
ScalarBase t -> Integer
ScalarBase t -> (Int, Int)
ScalarBase t -> (Integer, Int)
ScalarBase t -> ScalarBase t
ScalarBase t -> ScalarBase t -> ScalarBase t
forall t. RealFloat t => Floating (ScalarBase t)
forall t. RealFloat t => RealFrac (ScalarBase t)
forall t. RealFloat t => Int -> ScalarBase t -> ScalarBase t
forall t. RealFloat t => Integer -> Int -> ScalarBase t
forall t. RealFloat t => ScalarBase t -> Bool
forall t. RealFloat t => ScalarBase t -> Int
forall t. RealFloat t => ScalarBase t -> Integer
forall t. RealFloat t => ScalarBase t -> (Int, Int)
forall t. RealFloat t => ScalarBase t -> (Integer, Int)
forall t. RealFloat t => ScalarBase t -> ScalarBase t
forall t.
RealFloat t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
forall a.
RealFrac a
-> Floating a
-> (a -> Integer)
-> (a -> Int)
-> (a -> (Int, Int))
-> (a -> (Integer, Int))
-> (Integer -> Int -> a)
-> (a -> Int)
-> (a -> a)
-> (Int -> a -> a)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> a -> a)
-> RealFloat a
atan2 :: ScalarBase t -> ScalarBase t -> ScalarBase t
$catan2 :: forall t.
RealFloat t =>
ScalarBase t -> ScalarBase t -> ScalarBase t
isIEEE :: ScalarBase t -> Bool
$cisIEEE :: forall t. RealFloat t => ScalarBase t -> Bool
isNegativeZero :: ScalarBase t -> Bool
$cisNegativeZero :: forall t. RealFloat t => ScalarBase t -> Bool
isDenormalized :: ScalarBase t -> Bool
$cisDenormalized :: forall t. RealFloat t => ScalarBase t -> Bool
isInfinite :: ScalarBase t -> Bool
$cisInfinite :: forall t. RealFloat t => ScalarBase t -> Bool
isNaN :: ScalarBase t -> Bool
$cisNaN :: forall t. RealFloat t => ScalarBase t -> Bool
scaleFloat :: Int -> ScalarBase t -> ScalarBase t
$cscaleFloat :: forall t. RealFloat t => Int -> ScalarBase t -> ScalarBase t
significand :: ScalarBase t -> ScalarBase t
$csignificand :: forall t. RealFloat t => ScalarBase t -> ScalarBase t
exponent :: ScalarBase t -> Int
$cexponent :: forall t. RealFloat t => ScalarBase t -> Int
encodeFloat :: Integer -> Int -> ScalarBase t
$cencodeFloat :: forall t. RealFloat t => Integer -> Int -> ScalarBase t
decodeFloat :: ScalarBase t -> (Integer, Int)
$cdecodeFloat :: forall t. RealFloat t => ScalarBase t -> (Integer, Int)
floatRange :: ScalarBase t -> (Int, Int)
$cfloatRange :: forall t. RealFloat t => ScalarBase t -> (Int, Int)
floatDigits :: ScalarBase t -> Int
$cfloatDigits :: forall t. RealFloat t => ScalarBase t -> Int
floatRadix :: ScalarBase t -> Integer
$cfloatRadix :: forall t. RealFloat t => ScalarBase t -> Integer
$cp2RealFloat :: forall t. RealFloat t => Floating (ScalarBase t)
$cp1RealFloat :: forall t. RealFloat t => RealFrac (ScalarBase t)
RealFloat
           , PrimTagged (ScalarBase t)
Addr# -> State# s -> (# State# s, ScalarBase t #)
ByteArray# -> Int# -> ScalarBase t
Int# -> ByteArray# -> ScalarBase t
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
Proxy# name -> ScalarBase t -> Int#
PrimTagged (ScalarBase t)
-> (ScalarBase t -> ByteArray#)
-> (ScalarBase t -> ByteArray#)
-> (Int# -> ByteArray# -> ScalarBase t)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ScalarBase t #))
-> (forall s.
    MutableByteArray# s
    -> Int# -> ScalarBase t -> State# s -> State# s)
-> (forall s. Addr# -> State# s -> (# State# s, ScalarBase t #))
-> (forall s. ScalarBase t -> Addr# -> State# s -> State# s)
-> (ScalarBase t -> Int#)
-> (ScalarBase t -> Int#)
-> (ScalarBase t -> Int#)
-> (forall (name :: Symbol).
    (Elem name (PrimFields (ScalarBase t)), KnownSymbol name) =>
    Proxy# name -> ScalarBase t -> Int#)
-> (ByteArray# -> Int# -> ScalarBase t)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, ScalarBase t #))
-> (forall s.
    MutableByteArray# s
    -> Int# -> ScalarBase t -> State# s -> State# s)
-> PrimBytes (ScalarBase t)
ScalarBase t -> ByteArray#
ScalarBase t -> Int#
ScalarBase t -> Addr# -> State# s -> State# s
forall s. Addr# -> State# s -> (# State# s, ScalarBase t #)
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
forall s.
MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
forall a.
PrimTagged a
-> (a -> ByteArray#)
-> (a -> ByteArray#)
-> (Int# -> ByteArray# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> State# s -> (# State# s, a #))
-> (forall s. a -> Addr# -> State# s -> State# s)
-> (a -> Int#)
-> (a -> Int#)
-> (a -> Int#)
-> (forall (name :: Symbol).
    (Elem name (PrimFields a), KnownSymbol name) =>
    Proxy# name -> a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> PrimBytes a
forall t. PrimBytes t => PrimTagged (ScalarBase t)
forall t. PrimBytes t => ByteArray# -> Int# -> ScalarBase t
forall t. PrimBytes t => Int# -> ByteArray# -> ScalarBase t
forall t. PrimBytes t => ScalarBase t -> ByteArray#
forall t. PrimBytes t => ScalarBase t -> Int#
forall t s.
PrimBytes t =>
Addr# -> State# s -> (# State# s, ScalarBase t #)
forall t s.
PrimBytes t =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
forall t s.
PrimBytes t =>
MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
forall t s.
PrimBytes t =>
ScalarBase t -> Addr# -> State# s -> State# s
forall t (name :: Symbol).
(PrimBytes t, Elem name (PrimFields (ScalarBase t)),
 KnownSymbol name) =>
Proxy# name -> ScalarBase t -> Int#
forall s. ScalarBase t -> Addr# -> State# s -> State# s
forall (name :: Symbol).
(Elem name (PrimFields (ScalarBase t)), KnownSymbol name) =>
Proxy# name -> ScalarBase t -> Int#
writeArray :: MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
$cwriteArray :: forall t s.
PrimBytes t =>
MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
readArray :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
$creadArray :: forall t s.
PrimBytes t =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
indexArray :: ByteArray# -> Int# -> ScalarBase t
$cindexArray :: forall t. PrimBytes t => ByteArray# -> Int# -> ScalarBase t
byteFieldOffset :: Proxy# name -> ScalarBase t -> Int#
$cbyteFieldOffset :: forall t (name :: Symbol).
(PrimBytes t, Elem name (PrimFields (ScalarBase t)),
 KnownSymbol name) =>
Proxy# name -> ScalarBase t -> Int#
byteOffset :: ScalarBase t -> Int#
$cbyteOffset :: forall t. PrimBytes t => ScalarBase t -> Int#
byteAlign :: ScalarBase t -> Int#
$cbyteAlign :: forall t. PrimBytes t => ScalarBase t -> Int#
byteSize :: ScalarBase t -> Int#
$cbyteSize :: forall t. PrimBytes t => ScalarBase t -> Int#
writeAddr :: ScalarBase t -> Addr# -> State# s -> State# s
$cwriteAddr :: forall t s.
PrimBytes t =>
ScalarBase t -> Addr# -> State# s -> State# s
readAddr :: Addr# -> State# s -> (# State# s, ScalarBase t #)
$creadAddr :: forall t s.
PrimBytes t =>
Addr# -> State# s -> (# State# s, ScalarBase t #)
writeBytes :: MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
$cwriteBytes :: forall t s.
PrimBytes t =>
MutableByteArray# s -> Int# -> ScalarBase t -> State# s -> State# s
readBytes :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
$creadBytes :: forall t s.
PrimBytes t =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, ScalarBase t #)
fromBytes :: Int# -> ByteArray# -> ScalarBase t
$cfromBytes :: forall t. PrimBytes t => Int# -> ByteArray# -> ScalarBase t
getBytesPinned :: ScalarBase t -> ByteArray#
$cgetBytesPinned :: forall t. PrimBytes t => ScalarBase t -> ByteArray#
getBytes :: ScalarBase t -> ByteArray#
$cgetBytes :: forall t. PrimBytes t => ScalarBase t -> ByteArray#
$cp1PrimBytes :: forall t. PrimBytes t => PrimTagged (ScalarBase t)
PrimBytes)

instance Ord t => ProductOrder (ScalarBase t) where
  cmp :: ScalarBase t -> ScalarBase t -> PartialOrdering
cmp ScalarBase t
a ScalarBase t
b = Ordering -> PartialOrdering
fromOrdering (t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ScalarBase t -> t
forall t. ScalarBase t -> t
_unScalarBase ScalarBase t
a) (ScalarBase t -> t
forall t. ScalarBase t -> t
_unScalarBase ScalarBase t
b))
deriving instance Ord t => Ord (NonTransitive.ProductOrd (ScalarBase t))
deriving instance Ord t => Ord (Partial.ProductOrd (ScalarBase t))

instance PrimBytes t => PrimArray t (ScalarBase t) where
  broadcast# :: t -> ScalarBase t
broadcast# = t -> ScalarBase t
coerce
  {-# INLINE broadcast# #-}
  ix# :: Int# -> ScalarBase t -> t
ix# Int#
_ = ScalarBase t -> t
coerce
  {-# INLINE ix# #-}
  gen# :: CumulDims -> (s -> (# s, t #)) -> s -> (# s, ScalarBase t #)
gen# CumulDims
_ = (s -> (# s, t #)) -> s -> (# s, ScalarBase t #)
coerce
  {-# INLINE gen# #-}
  upd# :: CumulDims -> Int# -> t -> ScalarBase t -> ScalarBase t
upd# CumulDims
_ Int#
0# = ScalarBase t -> ScalarBase t -> ScalarBase t
forall a b. a -> b -> a
const (ScalarBase t -> ScalarBase t -> ScalarBase t)
-> (t -> ScalarBase t) -> t -> ScalarBase t -> ScalarBase t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ScalarBase t
forall t. t -> ScalarBase t
ScalarBase
  upd# CumulDims
_ Int#
_  = (ScalarBase t -> ScalarBase t) -> t -> ScalarBase t -> ScalarBase t
forall a b. a -> b -> a
const ScalarBase t -> ScalarBase t
forall a. a -> a
id
  {-# INLINE upd# #-}
  withArrayContent# :: (t -> r)
-> (CumulDims -> Int# -> ByteArray# -> r) -> ScalarBase t -> r
withArrayContent# t -> r
f CumulDims -> Int# -> ByteArray# -> r
_ ScalarBase t
x = t -> r
f (ScalarBase t -> t
forall t. ScalarBase t -> t
_unScalarBase ScalarBase t
x)
  {-# INLINE withArrayContent# #-}
  offsetElems :: ScalarBase t -> Int#
offsetElems ScalarBase t
_ = Int#
0#
  {-# INLINE offsetElems #-}
  uniqueOrCumulDims :: ScalarBase t -> Either t CumulDims
uniqueOrCumulDims = t -> Either t CumulDims
forall a b. a -> Either a b
Left (t -> Either t CumulDims)
-> (ScalarBase t -> t) -> ScalarBase t -> Either t CumulDims
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarBase t -> t
forall t. ScalarBase t -> t
_unScalarBase
  {-# INLINE uniqueOrCumulDims #-}
  fromElems# :: CumulDims -> Int# -> ByteArray# -> ScalarBase t
fromElems# CumulDims
_ Int#
off ByteArray#
ba = ByteArray# -> Int# -> ScalarBase t
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray ByteArray#
ba Int#
off
  {-# INLINE fromElems# #-}

_suppressHlintUnboxedTuplesWarning :: () -> (# (), () #)
_suppressHlintUnboxedTuplesWarning :: () -> (# (), () #)
_suppressHlintUnboxedTuplesWarning = () -> (# (), () #)
forall a. HasCallStack => a
undefined