{-
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.Wrapping
  ( Wrapping(..)
  , toWrapping
  ) 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(SatWrap), SaturatingNum(..))
import Clash.Class.Parity (Parity)
import Clash.Class.Resize (Resize(..))
import Clash.XException (NFDataX, ShowX)

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

{-# INLINE toWrapping #-}
toWrapping :: (SaturatingNum a) => a -> Wrapping a
toWrapping :: a -> Wrapping a
toWrapping = a -> Wrapping a
forall a. a -> Wrapping a
Wrapping

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

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

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

  -- Assume the default behaviour is to wrap anyway.

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

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

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

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

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

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

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

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

instance (Integral a, SaturatingNum a) => Integral (Wrapping a) where
  {-# INLINE quotRem #-}
  quotRem :: Wrapping a -> Wrapping a -> (Wrapping a, Wrapping a)
quotRem = (a -> a -> (a, a))
-> Wrapping a -> Wrapping a -> (Wrapping a, Wrapping a)
coerce (Integral a => a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem @a)

  {-# INLINE divMod #-}
  divMod :: Wrapping a -> Wrapping a -> (Wrapping a, Wrapping a)
divMod = (a -> a -> (a, a))
-> Wrapping a -> Wrapping a -> (Wrapping a, Wrapping a)
coerce (Integral a => a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod @a)

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

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

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