{-
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.Erroring
  ( Erroring
  , fromErroring  -- exported here because haddock https://github.com/haskell/haddock/issues/456
  , toErroring
  ) 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(SatError), SaturatingNum(..))
import Clash.Class.Parity (Parity)
import Clash.Class.Resize (Resize(..))
import Clash.XException (NFDataX, ShowX, errorX)

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

{-# INLINE toErroring #-}
toErroring :: (SaturatingNum a) => a -> Erroring a
toErroring :: a -> Erroring a
toErroring = a -> Erroring a
forall a. a -> Erroring a
Erroring

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

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

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

  negate :: Erroring a -> Erroring a
negate Erroring a
x
    | Erroring a
0 Erroring a -> Erroring a -> Bool
forall a. Eq a => a -> a -> Bool
== Erroring a
x = Erroring a
x
    | a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Bounded a => a
forall a. Bounded a => a
minBound @a = String -> Erroring a
forall a. HasCallStack => String -> a
errorX String
"Erroring.negate: result exceeds minBound"
    | Erroring a
x Erroring a -> Erroring a -> Bool
forall a. Eq a => a -> a -> Bool
== Erroring a
forall a. Bounded a => a
minBound = String -> Erroring a
forall a. HasCallStack => String -> a
errorX String
"Erroring.negate: result exceeds maxBound"
    | Bool
otherwise = (a -> a) -> Erroring a -> Erroring a
coerce (Num a => a -> a
forall a. Num a => a -> a
negate @a) Erroring a
x

  abs :: Erroring a -> Erroring a
abs Erroring a
x
    | Erroring a
x Erroring a -> Erroring a -> Bool
forall a. Eq a => a -> a -> Bool
== Erroring a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Erroring a
x Erroring a -> Erroring a -> Bool
forall a. Ord a => a -> a -> Bool
< Erroring a
0 = String -> Erroring a
forall a. HasCallStack => String -> a
errorX String
"Erroring.abs: result exceeds maxBound"
    | Bool
otherwise = (a -> a) -> Erroring a -> Erroring a
coerce (Num a => a -> a
forall a. Num a => a -> a
abs @a) Erroring a
x

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

instance (Enum a, SaturatingNum a) => Enum (Erroring a) where
  {-# INLINE succ #-}
  succ :: Erroring a -> Erroring a
succ = (a -> a) -> Erroring a -> Erroring a
coerce (SaturationMode -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a
satSucc @a SaturationMode
SatError)

  {-# INLINE pred #-}
  pred :: Erroring a -> Erroring a
pred = (a -> a) -> Erroring a -> Erroring a
coerce (SaturationMode -> a -> a
forall a. SaturatingNum a => SaturationMode -> a -> a
satPred @a SaturationMode
SatError)

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

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

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

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

  divMod :: Erroring a -> Erroring a -> (Erroring a, Erroring a)
divMod Erroring a
x Erroring a
y
    | Erroring a
x Erroring a -> Erroring a -> Bool
forall a. Eq a => a -> a -> Bool
== Erroring a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Erroring a
y Erroring a -> Erroring a -> Bool
forall a. Ord a => a -> a -> Bool
< Erroring a
0 Bool -> Bool -> Bool
&& Erroring a
y Erroring a -> Erroring a -> Bool
forall a. Eq a => a -> a -> Bool
== -Erroring a
1 =
        (String -> Erroring a
forall a. HasCallStack => String -> a
errorX String
"Erroring.divMod: result exceeds maxBound", Erroring a
0)
    | Bool
otherwise = (a -> a -> (a, a))
-> Erroring a -> Erroring a -> (Erroring a, Erroring a)
coerce (Integral a => a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod @a) Erroring a
x Erroring a
y

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

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

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