{-
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.Saturating
  ( Saturating(fromSaturating)
  , toSaturating
  ) 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(SatBound), SaturatingNum(..))
import Clash.Class.Parity (Parity)
import Clash.Class.Resize (Resize(..))
import Clash.XException (NFDataX, ShowX)

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

{-# INLINE toSaturating #-}
toSaturating :: (SaturatingNum a) => a -> Saturating a
toSaturating :: a -> Saturating a
toSaturating = a -> Saturating a
forall a. a -> Saturating a
Saturating

instance (Resize f) => Resize (Compose Saturating f) where
  {-# INLINE resize #-}
  resize
    :: forall a b
     . (KnownNat a, KnownNat b)
    => Compose Saturating f a
    -> Compose Saturating f b
  resize :: Compose Saturating f a -> Compose Saturating f b
resize = (f a -> f b) -> Compose Saturating f a -> Compose Saturating 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 Saturating f a
    -> Compose Saturating f (b + a)
  zeroExtend :: Compose Saturating f a -> Compose Saturating f (b + a)
zeroExtend = (f a -> f (b + a))
-> Compose Saturating f a -> Compose Saturating 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 Saturating f (a + b)
    -> Compose Saturating f a
  truncateB :: Compose Saturating f (a + b) -> Compose Saturating f a
truncateB = (f (a + b) -> f a)
-> Compose Saturating f (a + b) -> Compose Saturating 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 (Ord a, SaturatingNum a) => Num (Saturating a) where
  {-# INLINE (+) #-}
  + :: Saturating a -> Saturating a -> Saturating a
(+) = (a -> a -> a) -> Saturating a -> Saturating a -> Saturating a
coerce (SaturationMode -> a -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a -> a
satAdd @a SaturationMode
SatBound)

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

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

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

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

  {-# INLINE signum #-}
  signum :: Saturating a -> Saturating a
signum = (a -> a) -> Saturating a -> Saturating 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
  -- saturated, but in a way which remained synthesizable.
  fromInteger :: Integer -> Saturating a
fromInteger = (Integer -> a) -> Integer -> Saturating a
coerce (Num a => Integer -> a
forall a. Num a => Integer -> a
fromInteger @a)

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

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

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

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

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

instance (Integral a, SaturatingNum a) => Integral (Saturating a) where
  quotRem :: Saturating a -> Saturating a -> (Saturating a, Saturating a)
quotRem Saturating a
x Saturating a
y
    | Saturating a
x Saturating a -> Saturating a -> Bool
forall a. Eq a => a -> a -> Bool
== Saturating a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Saturating a
y Saturating a -> Saturating a -> Bool
forall a. Ord a => a -> a -> Bool
< Saturating a
0 Bool -> Bool -> Bool
&& Saturating a
y Saturating a -> Saturating a -> Bool
forall a. Eq a => a -> a -> Bool
== -Saturating a
1 = (Saturating a
forall a. Bounded a => a
maxBound, Saturating a
0)
    | Bool
otherwise = (a -> a -> (a, a))
-> Saturating a -> Saturating a -> (Saturating a, Saturating a)
coerce (Integral a => a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem @a) Saturating a
x Saturating a
y

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

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

instance (Fractional a, Ord a, SaturatingNum a) => Fractional (Saturating a) where
  {-# INLINE recip #-}
  recip :: Saturating a -> Saturating a
recip = (a -> a) -> Saturating a -> Saturating 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
  -- saturated, but in a way which remained synthesizable.
  fromRational :: Rational -> Saturating a
fromRational = (Rational -> a) -> Rational -> Saturating a
coerce (Fractional a => Rational -> a
forall a. Fractional a => Rational -> a
fromRational @a)

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