{-
Copyright   : (C) 2021, QBayLogic B.V.
License     : BSD2 (see the file LICENSE)
Maintainer  : QBayLogic B.V. <devops@qbaylogic.com>
-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Clash.Num.Zeroing
  ( Zeroing
  , fromZeroing  -- exported here because haddock https://github.com/haskell/haddock/issues/456
  , toZeroing
  ) where

import Control.DeepSeq (NFData)
import Data.Binary (Binary)
import Data.Bits (Bits, FiniteBits)
import Data.Coerce (coerce)
import Data.Functor.Compose (Compose(..))
import Data.Hashable (Hashable)
import GHC.TypeLits (KnownNat, type (+))
import Test.QuickCheck (Arbitrary)

import Clash.Class.BitPack (BitPack)
import Clash.Class.Num (SaturationMode(SatZero), SaturatingNum(..))
import Clash.Class.Parity (Parity)
import Clash.Class.Resize (Resize(..))
import Clash.XException (NFDataX, ShowX)

-- | A zeroing number type is one where all operations return zero if they go
-- out of bounds for the underlying type.
--
-- Numbers can be converted to zero by default using `toZeroing`.
--
newtype Zeroing a =
  Zeroing { Zeroing a -> a
fromZeroing :: a }
  deriving newtype
    ( Gen (Zeroing a)
Gen (Zeroing a)
-> (Zeroing a -> [Zeroing a]) -> Arbitrary (Zeroing a)
Zeroing a -> [Zeroing a]
forall a. Arbitrary a => Gen (Zeroing a)
forall a. Arbitrary a => Zeroing a -> [Zeroing a]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: Zeroing a -> [Zeroing a]
$cshrink :: forall a. Arbitrary a => Zeroing a -> [Zeroing a]
arbitrary :: Gen (Zeroing a)
$carbitrary :: forall a. Arbitrary a => Gen (Zeroing a)
Arbitrary
    , Get (Zeroing a)
[Zeroing a] -> Put
Zeroing a -> Put
(Zeroing a -> Put)
-> Get (Zeroing a) -> ([Zeroing a] -> Put) -> Binary (Zeroing a)
forall a. Binary a => Get (Zeroing a)
forall a. Binary a => [Zeroing a] -> Put
forall a. Binary a => Zeroing a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Zeroing a] -> Put
$cputList :: forall a. Binary a => [Zeroing a] -> Put
get :: Get (Zeroing a)
$cget :: forall a. Binary a => Get (Zeroing a)
put :: Zeroing a -> Put
$cput :: forall a. Binary a => Zeroing a -> Put
Binary
    , Eq (Zeroing a)
Zeroing a
Eq (Zeroing a)
-> (Zeroing a -> Zeroing a -> Zeroing a)
-> (Zeroing a -> Zeroing a -> Zeroing a)
-> (Zeroing a -> Zeroing a -> Zeroing a)
-> (Zeroing a -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> Zeroing a
-> (Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Bool)
-> (Zeroing a -> Maybe Int)
-> (Zeroing a -> Int)
-> (Zeroing a -> Bool)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int -> Zeroing a)
-> (Zeroing a -> Int)
-> Bits (Zeroing a)
Int -> Zeroing a
Zeroing a -> Bool
Zeroing a -> Int
Zeroing a -> Maybe Int
Zeroing a -> Zeroing a
Zeroing a -> Int -> Bool
Zeroing a -> Int -> Zeroing a
Zeroing a -> Zeroing a -> Zeroing a
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall a. Bits a => Eq (Zeroing a)
forall a. Bits a => Zeroing a
forall a. Bits a => Int -> Zeroing a
forall a. Bits a => Zeroing a -> Bool
forall a. Bits a => Zeroing a -> Int
forall a. Bits a => Zeroing a -> Maybe Int
forall a. Bits a => Zeroing a -> Zeroing a
forall a. Bits a => Zeroing a -> Int -> Bool
forall a. Bits a => Zeroing a -> Int -> Zeroing a
forall a. Bits a => Zeroing a -> Zeroing a -> Zeroing a
popCount :: Zeroing a -> Int
$cpopCount :: forall a. Bits a => Zeroing a -> Int
rotateR :: Zeroing a -> Int -> Zeroing a
$crotateR :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
rotateL :: Zeroing a -> Int -> Zeroing a
$crotateL :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
unsafeShiftR :: Zeroing a -> Int -> Zeroing a
$cunsafeShiftR :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
shiftR :: Zeroing a -> Int -> Zeroing a
$cshiftR :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
unsafeShiftL :: Zeroing a -> Int -> Zeroing a
$cunsafeShiftL :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
shiftL :: Zeroing a -> Int -> Zeroing a
$cshiftL :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
isSigned :: Zeroing a -> Bool
$cisSigned :: forall a. Bits a => Zeroing a -> Bool
bitSize :: Zeroing a -> Int
$cbitSize :: forall a. Bits a => Zeroing a -> Int
bitSizeMaybe :: Zeroing a -> Maybe Int
$cbitSizeMaybe :: forall a. Bits a => Zeroing a -> Maybe Int
testBit :: Zeroing a -> Int -> Bool
$ctestBit :: forall a. Bits a => Zeroing a -> Int -> Bool
complementBit :: Zeroing a -> Int -> Zeroing a
$ccomplementBit :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
clearBit :: Zeroing a -> Int -> Zeroing a
$cclearBit :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
setBit :: Zeroing a -> Int -> Zeroing a
$csetBit :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
bit :: Int -> Zeroing a
$cbit :: forall a. Bits a => Int -> Zeroing a
zeroBits :: Zeroing a
$czeroBits :: forall a. Bits a => Zeroing a
rotate :: Zeroing a -> Int -> Zeroing a
$crotate :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
shift :: Zeroing a -> Int -> Zeroing a
$cshift :: forall a. Bits a => Zeroing a -> Int -> Zeroing a
complement :: Zeroing a -> Zeroing a
$ccomplement :: forall a. Bits a => Zeroing a -> Zeroing a
xor :: Zeroing a -> Zeroing a -> Zeroing a
$cxor :: forall a. Bits a => Zeroing a -> Zeroing a -> Zeroing a
.|. :: Zeroing a -> Zeroing a -> Zeroing a
$c.|. :: forall a. Bits a => Zeroing a -> Zeroing a -> Zeroing a
.&. :: Zeroing a -> Zeroing a -> Zeroing a
$c.&. :: forall a. Bits a => Zeroing a -> Zeroing a -> Zeroing a
$cp1Bits :: forall a. Bits a => Eq (Zeroing a)
Bits
    , KnownNat (BitSize (Zeroing a))
KnownNat (BitSize (Zeroing a))
-> (Zeroing a -> BitVector (BitSize (Zeroing a)))
-> (BitVector (BitSize (Zeroing a)) -> Zeroing a)
-> BitPack (Zeroing a)
BitVector (BitSize (Zeroing a)) -> Zeroing a
Zeroing a -> BitVector (BitSize (Zeroing a))
forall a.
KnownNat (BitSize a)
-> (a -> BitVector (BitSize a))
-> (BitVector (BitSize a) -> a)
-> BitPack a
forall a. BitPack a => KnownNat (BitSize (Zeroing a))
forall a. BitPack a => BitVector (BitSize (Zeroing a)) -> Zeroing a
forall a. BitPack a => Zeroing a -> BitVector (BitSize (Zeroing a))
unpack :: BitVector (BitSize (Zeroing a)) -> Zeroing a
$cunpack :: forall a. BitPack a => BitVector (BitSize (Zeroing a)) -> Zeroing a
pack :: Zeroing a -> BitVector (BitSize (Zeroing a))
$cpack :: forall a. BitPack a => Zeroing a -> BitVector (BitSize (Zeroing a))
$cp1BitPack :: forall a. BitPack a => KnownNat (BitSize (Zeroing a))
BitPack
    , Zeroing a
Zeroing a -> Zeroing a -> Bounded (Zeroing a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Zeroing a
maxBound :: Zeroing a
$cmaxBound :: forall a. Bounded a => Zeroing a
minBound :: Zeroing a
$cminBound :: forall a. Bounded a => Zeroing a
Bounded
    , Zeroing a -> Zeroing a -> Bool
(Zeroing a -> Zeroing a -> Bool)
-> (Zeroing a -> Zeroing a -> Bool) -> Eq (Zeroing a)
forall a. Eq a => Zeroing a -> Zeroing a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Zeroing a -> Zeroing a -> Bool
$c/= :: forall a. Eq a => Zeroing a -> Zeroing a -> Bool
== :: Zeroing a -> Zeroing a -> Bool
$c== :: forall a. Eq a => Zeroing a -> Zeroing a -> Bool
Eq
    , Bits (Zeroing a)
Bits (Zeroing a)
-> (Zeroing a -> Int)
-> (Zeroing a -> Int)
-> (Zeroing a -> Int)
-> FiniteBits (Zeroing a)
Zeroing a -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
forall a. FiniteBits a => Bits (Zeroing a)
forall a. FiniteBits a => Zeroing a -> Int
countTrailingZeros :: Zeroing a -> Int
$ccountTrailingZeros :: forall a. FiniteBits a => Zeroing a -> Int
countLeadingZeros :: Zeroing a -> Int
$ccountLeadingZeros :: forall a. FiniteBits a => Zeroing a -> Int
finiteBitSize :: Zeroing a -> Int
$cfiniteBitSize :: forall a. FiniteBits a => Zeroing a -> Int
$cp1FiniteBits :: forall a. FiniteBits a => Bits (Zeroing a)
FiniteBits
    , Eq (Zeroing a)
Eq (Zeroing a)
-> (Int -> Zeroing a -> Int)
-> (Zeroing a -> Int)
-> Hashable (Zeroing a)
Int -> Zeroing a -> Int
Zeroing a -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Zeroing a)
forall a. Hashable a => Int -> Zeroing a -> Int
forall a. Hashable a => Zeroing a -> Int
hash :: Zeroing a -> Int
$chash :: forall a. Hashable a => Zeroing a -> Int
hashWithSalt :: Int -> Zeroing a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Zeroing a -> Int
$cp1Hashable :: forall a. Hashable a => Eq (Zeroing a)
Hashable
    , Zeroing a -> ()
(Zeroing a -> ()) -> NFData (Zeroing a)
forall a. NFData a => Zeroing a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Zeroing a -> ()
$crnf :: forall a. NFData a => Zeroing a -> ()
NFData
    , HasCallStack => String -> Zeroing a
String -> Zeroing a
Zeroing a -> Bool
Zeroing a -> ()
Zeroing a -> Zeroing a
(HasCallStack => String -> Zeroing a)
-> (Zeroing a -> Bool)
-> (Zeroing a -> Zeroing a)
-> (Zeroing a -> ())
-> NFDataX (Zeroing a)
forall a. (NFDataX a, HasCallStack) => String -> Zeroing a
forall a. NFDataX a => Zeroing a -> Bool
forall a. NFDataX a => Zeroing a -> ()
forall a. NFDataX a => Zeroing a -> Zeroing a
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
rnfX :: Zeroing a -> ()
$crnfX :: forall a. NFDataX a => Zeroing a -> ()
ensureSpine :: Zeroing a -> Zeroing a
$censureSpine :: forall a. NFDataX a => Zeroing a -> Zeroing a
hasUndefined :: Zeroing a -> Bool
$chasUndefined :: forall a. NFDataX a => Zeroing a -> Bool
deepErrorX :: String -> Zeroing a
$cdeepErrorX :: forall a. (NFDataX a, HasCallStack) => String -> Zeroing a
NFDataX
    , Eq (Zeroing a)
Eq (Zeroing a)
-> (Zeroing a -> Zeroing a -> Ordering)
-> (Zeroing a -> Zeroing a -> Bool)
-> (Zeroing a -> Zeroing a -> Bool)
-> (Zeroing a -> Zeroing a -> Bool)
-> (Zeroing a -> Zeroing a -> Bool)
-> (Zeroing a -> Zeroing a -> Zeroing a)
-> (Zeroing a -> Zeroing a -> Zeroing a)
-> Ord (Zeroing a)
Zeroing a -> Zeroing a -> Bool
Zeroing a -> Zeroing a -> Ordering
Zeroing a -> Zeroing a -> Zeroing a
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 a. Ord a => Eq (Zeroing a)
forall a. Ord a => Zeroing a -> Zeroing a -> Bool
forall a. Ord a => Zeroing a -> Zeroing a -> Ordering
forall a. Ord a => Zeroing a -> Zeroing a -> Zeroing a
min :: Zeroing a -> Zeroing a -> Zeroing a
$cmin :: forall a. Ord a => Zeroing a -> Zeroing a -> Zeroing a
max :: Zeroing a -> Zeroing a -> Zeroing a
$cmax :: forall a. Ord a => Zeroing a -> Zeroing a -> Zeroing a
>= :: Zeroing a -> Zeroing a -> Bool
$c>= :: forall a. Ord a => Zeroing a -> Zeroing a -> Bool
> :: Zeroing a -> Zeroing a -> Bool
$c> :: forall a. Ord a => Zeroing a -> Zeroing a -> Bool
<= :: Zeroing a -> Zeroing a -> Bool
$c<= :: forall a. Ord a => Zeroing a -> Zeroing a -> Bool
< :: Zeroing a -> Zeroing a -> Bool
$c< :: forall a. Ord a => Zeroing a -> Zeroing a -> Bool
compare :: Zeroing a -> Zeroing a -> Ordering
$ccompare :: forall a. Ord a => Zeroing a -> Zeroing a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Zeroing a)
Ord
    , Zeroing a -> Bool
(Zeroing a -> Bool) -> (Zeroing a -> Bool) -> Parity (Zeroing a)
forall a. Parity a => Zeroing a -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> Parity a
odd :: Zeroing a -> Bool
$codd :: forall a. Parity a => Zeroing a -> Bool
even :: Zeroing a -> Bool
$ceven :: forall a. Parity a => Zeroing a -> Bool
Parity
    , Int -> Zeroing a -> ShowS
[Zeroing a] -> ShowS
Zeroing a -> String
(Int -> Zeroing a -> ShowS)
-> (Zeroing a -> String)
-> ([Zeroing a] -> ShowS)
-> Show (Zeroing a)
forall a. Show a => Int -> Zeroing a -> ShowS
forall a. Show a => [Zeroing a] -> ShowS
forall a. Show a => Zeroing a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Zeroing a] -> ShowS
$cshowList :: forall a. Show a => [Zeroing a] -> ShowS
show :: Zeroing a -> String
$cshow :: forall a. Show a => Zeroing a -> String
showsPrec :: Int -> Zeroing a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Zeroing a -> ShowS
Show
    , Int -> Zeroing a -> ShowS
[Zeroing a] -> ShowS
Zeroing a -> String
(Int -> Zeroing a -> ShowS)
-> (Zeroing a -> String)
-> ([Zeroing a] -> ShowS)
-> ShowX (Zeroing a)
forall a. ShowX a => Int -> Zeroing a -> ShowS
forall a. ShowX a => [Zeroing a] -> ShowS
forall a. ShowX a => Zeroing a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> ShowX a
showListX :: [Zeroing a] -> ShowS
$cshowListX :: forall a. ShowX a => [Zeroing a] -> ShowS
showX :: Zeroing a -> String
$cshowX :: forall a. ShowX a => Zeroing a -> String
showsPrecX :: Int -> Zeroing a -> ShowS
$cshowsPrecX :: forall a. ShowX a => Int -> Zeroing a -> ShowS
ShowX
    )

{-# INLINE toZeroing #-}
toZeroing :: (SaturatingNum a) => a -> Zeroing a
toZeroing :: a -> Zeroing a
toZeroing = a -> Zeroing a
forall a. a -> Zeroing a
Zeroing

instance (Resize f) => Resize (Compose Zeroing f) where
  {-# INLINE resize #-}
  resize
    :: forall a b
     . (KnownNat a, KnownNat b)
    => Compose Zeroing f a
    -> Compose Zeroing f b
  resize :: Compose Zeroing f a -> Compose Zeroing f b
resize = (f a -> f b) -> Compose Zeroing f a -> Compose Zeroing f b
coerce ((KnownNat a, KnownNat b) => f a -> f b
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f b
resize @f @a @b)

  {-# INLINE zeroExtend #-}
  zeroExtend
    :: forall a b
     . (KnownNat a, KnownNat b)
    => Compose Zeroing f a
    -> Compose Zeroing f (b + a)
  zeroExtend :: Compose Zeroing f a -> Compose Zeroing f (b + a)
zeroExtend = (f a -> f (b + a))
-> Compose Zeroing f a -> Compose Zeroing f (b + a)
coerce ((KnownNat a, KnownNat b) => f a -> f (b + a)
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f (b + a)
zeroExtend @f @a @b)

  {-# INLINE truncateB #-}
  truncateB
    :: forall a b
     . (KnownNat a)
    => Compose Zeroing f (a + b)
    -> Compose Zeroing f a
  truncateB :: Compose Zeroing f (a + b) -> Compose Zeroing f a
truncateB = (f (a + b) -> f a)
-> Compose Zeroing f (a + b) -> Compose Zeroing f a
coerce (KnownNat a => f (a + b) -> f a
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a) =>
f (a + b) -> f a
truncateB @f @a @b)

instance (Bounded a, Ord a, SaturatingNum a) => Num (Zeroing a) where
  {-# INLINE (+) #-}
  + :: Zeroing a -> Zeroing a -> Zeroing a
(+) = (a -> a -> a) -> Zeroing a -> Zeroing a -> Zeroing a
coerce (SaturationMode -> a -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a -> a
satAdd @a SaturationMode
SatZero)

  {-# INLINE (-) #-}
  (-) = (a -> a -> a) -> Zeroing a -> Zeroing a -> Zeroing a
coerce (SaturationMode -> a -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a -> a
satSub @a SaturationMode
SatZero)

  {-# INLINE (*) #-}
  * :: Zeroing a -> Zeroing a -> Zeroing a
(*) = (a -> a -> a) -> Zeroing a -> Zeroing a -> Zeroing a
coerce (SaturationMode -> a -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a -> a
satMul @a SaturationMode
SatZero)

  negate :: Zeroing a -> Zeroing a
negate Zeroing a
x
    | a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Bounded a => a
forall a. Bounded a => a
minBound @a = Zeroing a
0
    | Zeroing a
x Zeroing a -> Zeroing a -> Bool
forall a. Eq a => a -> a -> Bool
== Zeroing a
forall a. Bounded a => a
minBound = Zeroing a
0
    | Bool
otherwise = (a -> a) -> Zeroing a -> Zeroing a
coerce (Num a => a -> a
forall a. Num a => a -> a
negate @a) Zeroing a
x

  abs :: Zeroing a -> Zeroing a
abs Zeroing a
x
    | Zeroing a
x Zeroing a -> Zeroing a -> Bool
forall a. Eq a => a -> a -> Bool
== Zeroing a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Zeroing a
x Zeroing a -> Zeroing a -> Bool
forall a. Ord a => a -> a -> Bool
< Zeroing a
0 = Zeroing a
0
    | Bool
otherwise = (a -> a) -> Zeroing a -> Zeroing a
coerce (Num a => a -> a
forall a. Num a => a -> a
abs @a) Zeroing a
x

  {-# INLINE signum #-}
  signum :: Zeroing a -> Zeroing a
signum = (a -> a) -> Zeroing a -> Zeroing a
coerce (Num a => a -> a
forall a. Num a => a -> a
signum @a)

  {-# INLINE fromInteger #-}
  -- TODO This does what the underlying representation does if the Integer
  -- is not in range (typically wrapping). It would be better if this also
  -- returned zero, but in a way which remained synthesizable.
  fromInteger :: Integer -> Zeroing a
fromInteger = (Integer -> a) -> Integer -> Zeroing a
coerce (Num a => Integer -> a
forall a. Num a => Integer -> a
fromInteger @a)

instance (Enum a, SaturatingNum a) => Enum (Zeroing a) where
  {-# INLINE succ #-}
  -- Deliberately breaks the Enum law that succ maxBound ~> error
  succ :: Zeroing a -> Zeroing a
succ = (a -> a) -> Zeroing a -> Zeroing a
coerce (SaturationMode -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a
satSucc @a SaturationMode
SatZero)

  {-# INLINE pred #-}
  -- Deliberately breaks the Enum law that pred minBound ~> error
  pred :: Zeroing a -> Zeroing a
pred = (a -> a) -> Zeroing a -> Zeroing a
coerce (SaturationMode -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a
satPred @a SaturationMode
SatZero)

  {-# INLINE toEnum #-}
  toEnum :: Int -> Zeroing a
toEnum = (Int -> a) -> Int -> Zeroing a
coerce (Enum a => Int -> a
forall a. Enum a => Int -> a
toEnum @a)

  {-# INLINE fromEnum #-}
  fromEnum :: Zeroing a -> Int
fromEnum = (a -> Int) -> Zeroing a -> Int
coerce (Enum a => a -> Int
forall a. Enum a => a -> Int
fromEnum @a)

instance (Real a, SaturatingNum a) => Real (Zeroing a) where
  {-# INLINE toRational #-}
  toRational :: Zeroing a -> Rational
toRational = (a -> Rational) -> Zeroing a -> Rational
coerce (Real a => a -> Rational
forall a. Real a => a -> Rational
toRational @a)

instance (Integral a, SaturatingNum a) => Integral (Zeroing a) where
  -- NOTE the seemingly duplicate "y < 0 && y == -1" guards against unsigned types
  quotRem :: Zeroing a -> Zeroing a -> (Zeroing a, Zeroing a)
quotRem Zeroing a
x Zeroing a
y
    | Zeroing a
x Zeroing a -> Zeroing a -> Bool
forall a. Eq a => a -> a -> Bool
== Zeroing a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Zeroing a
y Zeroing a -> Zeroing a -> Bool
forall a. Ord a => a -> a -> Bool
< Zeroing a
0 Bool -> Bool -> Bool
&& Zeroing a
y Zeroing a -> Zeroing a -> Bool
forall a. Eq a => a -> a -> Bool
== -Zeroing a
1 = (Zeroing a
0, Zeroing a
0)
    | Bool
otherwise = (a -> a -> (a, a))
-> Zeroing a -> Zeroing a -> (Zeroing a, Zeroing a)
coerce (Integral a => a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem @a) Zeroing a
x Zeroing a
y

  divMod :: Zeroing a -> Zeroing a -> (Zeroing a, Zeroing a)
divMod Zeroing a
x Zeroing a
y
    | Zeroing a
x Zeroing a -> Zeroing a -> Bool
forall a. Eq a => a -> a -> Bool
== Zeroing a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Zeroing a
y Zeroing a -> Zeroing a -> Bool
forall a. Ord a => a -> a -> Bool
< Zeroing a
0 Bool -> Bool -> Bool
&& Zeroing a
y Zeroing a -> Zeroing a -> Bool
forall a. Eq a => a -> a -> Bool
== -Zeroing a
1 = (Zeroing a
0, Zeroing a
0)
    | Bool
otherwise = (a -> a -> (a, a))
-> Zeroing a -> Zeroing a -> (Zeroing a, Zeroing a)
coerce (Integral a => a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod @a) Zeroing a
x Zeroing a
y

  {-# INLINE toInteger #-}
  toInteger :: Zeroing a -> Integer
toInteger = (a -> Integer) -> Zeroing a -> Integer
coerce (Integral a => a -> Integer
forall a. Integral a => a -> Integer
toInteger @a)

instance (Fractional a, Ord a, SaturatingNum a) => Fractional (Zeroing a) where
  {-# INLINE recip #-}
  recip :: Zeroing a -> Zeroing a
recip = (a -> a) -> Zeroing a -> Zeroing a
coerce (Fractional a => a -> a
forall a. Fractional a => a -> a
recip @a)

  {-# INLINE fromRational #-}
  -- TODO This does what the underlying representation does if the Rational
  -- is not in range (typically wrapping). It would be better if this also
  -- returned zero, but in a way which remained synthesizable.
  fromRational :: Rational -> Zeroing a
fromRational = (Rational -> a) -> Rational -> Zeroing a
coerce (Fractional a => Rational -> a
forall a. Fractional a => Rational -> a
fromRational @a)

instance (RealFrac a, SaturatingNum a) => RealFrac (Zeroing a) where
  {-# INLINE properFraction #-}
  properFraction :: forall b. (Integral b) => Zeroing a -> (b, Zeroing a)
  properFraction :: Zeroing a -> (b, Zeroing a)
properFraction = (a -> (b, a)) -> Zeroing a -> (b, Zeroing a)
coerce (Integral b => a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction @a @b)