{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}

module Data.Connection.Float (
    -- * Connections
    f32i08,
    f32i16,
    f64i08,
    f64i16,
    f64i32,
    f64f32,

    -- * Float
    min32,
    max32,
    ulp32,
    near32,
    shift32,

    -- * Double
    min64,
    max64,
    ulp64,
    near64,
    shift64,
    until,
) where

import safe Data.Bool
import safe Data.Connection.Conn
import safe Data.Int
import safe Data.Order
import safe Data.Order.Extended
import safe Data.Order.Syntax hiding (max, min)
import safe Data.Word
import safe GHC.Float as F
import safe Prelude hiding (Eq (..), Ord (..), until)
import safe qualified Prelude as P

---------------------------------------------------------------------
-- Connections
---------------------------------------------------------------------

-- | All 'Data.Int.Int08' values are exactly representable in a 'Float'.
f32i08 :: Conn k Float (Extended Int8)
f32i08 :: Conn k Float (Extended Int8)
f32i08 = Float -> Conn k Float (Extended Int8)
forall a b (k :: Kan).
(RealFrac a, Preorder a, Bounded b, Integral b) =>
a -> Conn k a (Extended b)
triple Float
127

-- | All 'Data.Int.Int16' values are exactly representable in a 'Float'.
--
--  > ceilingWith f32i16 32767.0
--  Extended 32767
--  > ceilingWith f32i16 32767.1
--  Top
f32i16 :: Conn k Float (Extended Int16)
f32i16 :: Conn k Float (Extended Int16)
f32i16 = Float -> Conn k Float (Extended Int16)
forall a b (k :: Kan).
(RealFrac a, Preorder a, Bounded b, Integral b) =>
a -> Conn k a (Extended b)
triple Float
32767

-- | All 'Data.Int.Int08' values are exactly representable in a 'Double'.
f64i08 :: Conn k Double (Extended Int8)
f64i08 :: Conn k Double (Extended Int8)
f64i08 = Double -> Conn k Double (Extended Int8)
forall a b (k :: Kan).
(RealFrac a, Preorder a, Bounded b, Integral b) =>
a -> Conn k a (Extended b)
triple Double
127

-- | All 'Data.Int.Int16' values are exactly representable in a 'Double'.
f64i16 :: Conn k Double (Extended Int16)
f64i16 :: Conn k Double (Extended Int16)
f64i16 = Double -> Conn k Double (Extended Int16)
forall a b (k :: Kan).
(RealFrac a, Preorder a, Bounded b, Integral b) =>
a -> Conn k a (Extended b)
triple Double
32767

-- | All 'Data.Int.Int32' values are exactly representable in a 'Double'.
f64i32 :: Conn k Double (Extended Int32)
f64i32 :: Conn k Double (Extended Int32)
f64i32 = Double -> Conn k Double (Extended Int32)
forall a b (k :: Kan).
(RealFrac a, Preorder a, Bounded b, Integral b) =>
a -> Conn k a (Extended b)
triple Double
2147483647

f64f32 :: Conn k Double Float
f64f32 :: Conn k Double Float
f64f32 = (Double -> Float)
-> (Float -> Double) -> (Double -> Float) -> Conn k Double Float
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn Double -> Float
f1 Float -> Double
g Double -> Float
f2
  where
    f1 :: Double -> Float
f1 Double
x =
        let est :: Float
est = Double -> Float
F.double2Float Double
x
         in if Float -> Double
g Float
est Double -> Double -> Bool
forall a. Preorder a => a -> a -> Bool
>~ Double
x
                then Float
est
                else Float -> (Float -> Double) -> Double -> Float
forall a. Preorder a => Float -> (Float -> a) -> a -> Float
ascend32 Float
est Float -> Double
g Double
x

    f2 :: Double -> Float
f2 Double
x =
        let est :: Float
est = Double -> Float
F.double2Float Double
x
         in if Float -> Double
g Float
est Double -> Double -> Bool
forall a. Preorder a => a -> a -> Bool
<~ Double
x
                then Float
est
                else Float -> (Float -> Double) -> Double -> Float
forall a. Preorder a => Float -> (Float -> a) -> a -> Float
descend32 Float
est Float -> Double
g Double
x

    g :: Float -> Double
g = Float -> Double
F.float2Double

    ascend32 :: Float -> (Float -> a) -> a -> Float
ascend32 Float
z Float -> a
g1 a
y = (Float -> Bool)
-> (Float -> Float -> Bool) -> (Float -> Float) -> Float -> Float
forall a. (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
until (\Float
x -> Float -> a
g1 Float
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
>~ a
y) Float -> Float -> Bool
forall a. Preorder a => a -> a -> Bool
(<~) (Int32 -> Float -> Float
shift32 Int32
1) Float
z

    descend32 :: Float -> (Float -> a) -> a -> Float
descend32 Float
z Float -> a
h1 a
x = (Float -> Bool)
-> (Float -> Float -> Bool) -> (Float -> Float) -> Float -> Float
forall a. (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
until (\Float
y -> Float -> a
h1 Float
y a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
<~ a
x) Float -> Float -> Bool
forall a. Preorder a => a -> a -> Bool
(>~) (Int32 -> Float -> Float
shift32 (-Int32
1)) Float
z

---------------------------------------------------------------------
-- Float
---------------------------------------------------------------------

-- | A /NaN/-handling min32 function.
--
-- > min32 x NaN = x
-- > min32 NaN y = y
min32 :: Float -> Float -> Float
min32 :: Float -> Float -> Float
min32 Float
x Float
y = case (Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x, Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
y) of
    (Bool
False, Bool
False) -> if Float
x Float -> Float -> Bool
forall a. Order a => a -> a -> Bool
<= Float
y then Float
x else Float
y
    (Bool
False, Bool
True) -> Float
x
    (Bool
True, Bool
False) -> Float
y
    (Bool
True, Bool
True) -> Float
x

-- | A /NaN/-handling max32 function.
--
-- > max32 x NaN = x
-- > max32 NaN y = y
max32 :: Float -> Float -> Float
max32 :: Float -> Float -> Float
max32 Float
x Float
y = case (Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x, Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
y) of
    (Bool
False, Bool
False) -> if Float
x Float -> Float -> Bool
forall a. Order a => a -> a -> Bool
>= Float
y then Float
x else Float
y
    (Bool
False, Bool
True) -> Float
x
    (Bool
True, Bool
False) -> Float
y
    (Bool
True, Bool
True) -> Float
x

-- | Compute the signed distance between two floats in units of least precision.
--
-- >>> ulp32 1.0 (shift32 1 1.0)
-- Just (LT,1)
-- >>> ulp32 (0.0/0.0) 1.0
-- Nothing
ulp32 :: Float -> Float -> Maybe (Ordering, Word32)
ulp32 :: Float -> Float -> Maybe (Ordering, Word32)
ulp32 Float
x Float
y = (Ordering -> (Ordering, Word32))
-> Maybe Ordering -> Maybe (Ordering, Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ordering -> (Ordering, Word32)
forall b. Num b => Ordering -> (Ordering, b)
f (Maybe Ordering -> Maybe (Ordering, Word32))
-> Maybe Ordering -> Maybe (Ordering, Word32)
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Maybe Ordering
forall a. Preorder a => a -> a -> Maybe Ordering
pcompare Float
x Float
y
  where
    x' :: Int32
x' = Float -> Int32
floatInt32 Float
x
    y' :: Int32
y' = Float -> Int32
floatInt32 Float
y
    f :: Ordering -> (Ordering, b)
f Ordering
LT = (Ordering
LT, Int32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> b) -> (Int32 -> Int32) -> Int32 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
forall a. Num a => a -> a
abs (Int32 -> b) -> Int32 -> b
forall a b. (a -> b) -> a -> b
$ Int32
y' Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
x')
    f Ordering
EQ = (Ordering
EQ, b
0)
    f Ordering
GT = (Ordering
GT, Int32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> b) -> (Int32 -> Int32) -> Int32 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
forall a. Num a => a -> a
abs (Int32 -> b) -> Int32 -> b
forall a b. (a -> b) -> a -> b
$ Int32
x' Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
y')

-- | Compare two floats for approximate equality.
--
-- Required accuracy is specified in units of least precision.
--
-- See also <https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/>.
near32 :: Word32 -> Float -> Float -> Bool
near32 :: Word32 -> Float -> Float -> Bool
near32 Word32
tol Float
x Float
y = Bool
-> ((Ordering, Word32) -> Bool) -> Maybe (Ordering, Word32) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Word32 -> Word32 -> Bool
forall a. Order a => a -> a -> Bool
<= Word32
tol) (Word32 -> Bool)
-> ((Ordering, Word32) -> Word32) -> (Ordering, Word32) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ordering, Word32) -> Word32
forall a b. (a, b) -> b
snd) (Maybe (Ordering, Word32) -> Bool)
-> Maybe (Ordering, Word32) -> Bool
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Maybe (Ordering, Word32)
ulp32 Float
x Float
y

-- | Shift a float by /n/ units of least precision.
--
-- >>> shift32 1 0
-- 1.0e-45
-- >>> shift32 1 1 - 1
-- 1.1920929e-7
-- >>> shift32 1 $ 0/0
-- NaN
-- >>> shift32 (-1) $ 0/0
-- NaN
-- >>> shift32 1 $ 1/0
-- Infinity
shift32 :: Int32 -> Float -> Float
shift32 :: Int32 -> Float -> Float
shift32 Int32
n Float
x
    | Float
x Float -> Float -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Float
0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0 = Float
x
    | Bool
otherwise = Int32 -> Float
int32Float (Int32 -> Float) -> (Float -> Int32) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
clamp32 (Int32 -> Int32) -> (Float -> Int32) -> Float -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
n) (Int32 -> Int32) -> (Float -> Int32) -> Float -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int32
floatInt32 (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x

---------------------------------------------------------------------
-- Double
---------------------------------------------------------------------

-- | A /NaN/-handling min function.
--
-- > min64 x NaN = x
-- > min64 NaN y = y
min64 :: Double -> Double -> Double
min64 :: Double -> Double -> Double
min64 Double
x Double
y = case (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x, Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
y) of
    (Bool
False, Bool
False) -> if Double
x Double -> Double -> Bool
forall a. Order a => a -> a -> Bool
<= Double
y then Double
x else Double
y
    (Bool
False, Bool
True) -> Double
x
    (Bool
True, Bool
False) -> Double
y
    (Bool
True, Bool
True) -> Double
x

-- | A /NaN/-handling max function.
--
-- > max64 x NaN = x
-- > max64 NaN y = y
max64 :: Double -> Double -> Double
max64 :: Double -> Double -> Double
max64 Double
x Double
y = case (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x, Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
y) of
    (Bool
False, Bool
False) -> if Double
x Double -> Double -> Bool
forall a. Order a => a -> a -> Bool
>= Double
y then Double
x else Double
y
    (Bool
False, Bool
True) -> Double
x
    (Bool
True, Bool
False) -> Double
y
    (Bool
True, Bool
True) -> Double
x

-- | Compute the signed distance between two doubles in units of least precision.
--
-- >>> ulp64 1.0 (shift64 1 1.0)
-- Just (LT,1)
-- >>> ulp64 (0.0/0.0) 1.0
-- Nothing
ulp64 :: Double -> Double -> Maybe (Ordering, Word64)
ulp64 :: Double -> Double -> Maybe (Ordering, Word64)
ulp64 Double
x Double
y = (Ordering -> (Ordering, Word64))
-> Maybe Ordering -> Maybe (Ordering, Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ordering -> (Ordering, Word64)
forall b. Num b => Ordering -> (Ordering, b)
f (Maybe Ordering -> Maybe (Ordering, Word64))
-> Maybe Ordering -> Maybe (Ordering, Word64)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Maybe Ordering
forall a. Preorder a => a -> a -> Maybe Ordering
pcompare Double
x Double
y
  where
    x' :: Int64
x' = Double -> Int64
doubleInt64 Double
x
    y' :: Int64
y' = Double -> Int64
doubleInt64 Double
y
    f :: Ordering -> (Ordering, b)
f Ordering
LT = (Ordering
LT, Int64 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> b) -> (Int64 -> Int64) -> Int64 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a. Num a => a -> a
abs (Int64 -> b) -> Int64 -> b
forall a b. (a -> b) -> a -> b
$ Int64
y' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
x')
    f Ordering
EQ = (Ordering
EQ, b
0)
    f Ordering
GT = (Ordering
GT, Int64 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> b) -> (Int64 -> Int64) -> Int64 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a. Num a => a -> a
abs (Int64 -> b) -> Int64 -> b
forall a b. (a -> b) -> a -> b
$ Int64
x' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
y')

-- | Compare two double-precision floats for approximate equality.
--
-- Required accuracy is specified in units of least precision.
--
-- See also <https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/>.
near64 :: Word64 -> Double -> Double -> Bool
near64 :: Word64 -> Double -> Double -> Bool
near64 Word64
tol Double
x Double
y = Bool
-> ((Ordering, Word64) -> Bool) -> Maybe (Ordering, Word64) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Word64 -> Word64 -> Bool
forall a. Order a => a -> a -> Bool
<= Word64
tol) (Word64 -> Bool)
-> ((Ordering, Word64) -> Word64) -> (Ordering, Word64) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ordering, Word64) -> Word64
forall a b. (a, b) -> b
snd) (Maybe (Ordering, Word64) -> Bool)
-> Maybe (Ordering, Word64) -> Bool
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Maybe (Ordering, Word64)
ulp64 Double
x Double
y

-- | Shift by /n/ units of least precision.
--
-- >>> shift64 1 0
-- 5.0e-324
-- >>> shift64 1 1 - 1
-- 2.220446049250313e-16
-- >>> shift64 1 $ 0/0
-- NaN
-- >>> shift64 (-1) $ 0/0
-- NaN
-- >>> shift64 1 $ 1/0
-- Infinity
shift64 :: Int64 -> Double -> Double
shift64 :: Int64 -> Double -> Double
shift64 Int64
n Double
x
    | Double
x Double -> Double -> Bool
forall a. Preorder a => a -> a -> Bool
~~ Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0 = Double
x
    | Bool
otherwise = Int64 -> Double
int64Double (Int64 -> Double) -> (Double -> Int64) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
clamp64 (Int64 -> Int64) -> (Double -> Int64) -> Double -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n) (Int64 -> Int64) -> (Double -> Int64) -> Double -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int64
doubleInt64 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
x

---------------------------------------------------------------------
-- Internal
---------------------------------------------------------------------

{-# INLINE until #-}
until :: (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
until :: (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
until a -> Bool
pre a -> a -> Bool
rel a -> a
f a
seed = a -> a
go a
seed
  where
    go :: a -> a
go a
x
        | a
x' a -> a -> Bool
`rel` a
x = a
x
        | a -> Bool
pre a
x = a
x
        | Bool
otherwise = a -> a
go a
x'
      where
        x' :: a
x' = a -> a
f a
x

-- Non-monotonic function
signed32 :: Word32 -> Int32
signed32 :: Word32 -> Int32
signed32 Word32
x
    | Word32
x Word32 -> Word32 -> Bool
forall a. Preorder a => a -> a -> Bool
< Word32
0x80000000 = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x
    | Bool
otherwise = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
0x80000000))

-- Non-monotonic function
signed64 :: Word64 -> Int64
signed64 :: Word64 -> Int64
signed64 Word64
x
    | Word64
x Word64 -> Word64 -> Bool
forall a. Preorder a => a -> a -> Bool
< Word64
0x8000000000000000 = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
    | Bool
otherwise = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
P.- (Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
P.- Word64
0x8000000000000000))

-- Non-monotonic function converting from 2s-complement format.
unsigned32 :: Int32 -> Word32
unsigned32 :: Int32 -> Word32
unsigned32 Int32
x
    | Int32
x Int32 -> Int32 -> Bool
forall a. Order a => a -> a -> Bool
>= Int32
0 = Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x
    | Bool
otherwise = Word32
0x80000000 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
forall a. Bounded a => a
maxBound Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x))

-- Non-monotonic function converting from 2s-complement format.
unsigned64 :: Int64 -> Word64
unsigned64 :: Int64 -> Word64
unsigned64 Int64
x
    | Int64
x Int64 -> Int64 -> Bool
forall a. Preorder a => a -> a -> Bool
>~ Int64
0 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x
    | Bool
otherwise = Word64
0x8000000000000000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
P.- (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x))

int32Float :: Int32 -> Float
int32Float :: Int32 -> Float
int32Float = Word32 -> Float
F.castWord32ToFloat (Word32 -> Float) -> (Int32 -> Word32) -> Int32 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
unsigned32

floatInt32 :: Float -> Int32
floatInt32 :: Float -> Int32
floatInt32 = Word32 -> Int32
signed32 (Word32 -> Int32) -> (Float -> Word32) -> Float -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
0) (Word32 -> Word32) -> (Float -> Word32) -> Float -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
F.castFloatToWord32

int64Double :: Int64 -> Double
int64Double :: Int64 -> Double
int64Double = Word64 -> Double
F.castWord64ToDouble (Word64 -> Double) -> (Int64 -> Word64) -> Int64 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
unsigned64

doubleInt64 :: Double -> Int64
doubleInt64 :: Double -> Int64
doubleInt64 = Word64 -> Int64
signed64 (Word64 -> Int64) -> (Double -> Word64) -> Double -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
0) (Word64 -> Word64) -> (Double -> Word64) -> Double -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
F.castDoubleToWord64

-- Clamp between the int representations of -1/0 and 1/0
clamp32 :: Int32 -> Int32
clamp32 :: Int32 -> Int32
clamp32 = Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
P.max (-Int32
2139095041) (Int32 -> Int32) -> (Int32 -> Int32) -> Int32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
P.min Int32
2139095040

-- Clamp between the int representations of -1/0 and 1/0
clamp64 :: Int64 -> Int64
clamp64 :: Int64 -> Int64
clamp64 = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
P.max (-Int64
9218868437227405313) (Int64 -> Int64) -> (Int64 -> Int64) -> Int64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
P.min Int64
9218868437227405312

triple :: (RealFrac a, Preorder a, Bounded b, Integral b) => a -> Conn k a (Extended b)
triple :: a -> Conn k a (Extended b)
triple a
high = (a -> Extended b)
-> (Extended b -> a) -> (a -> Extended b) -> Conn k a (Extended b)
forall a b (k :: Kan).
(a -> b) -> (b -> a) -> (a -> b) -> Conn k a b
Conn a -> Extended b
f Extended b -> a
g a -> Extended b
h
  where
    f :: a -> Extended b
f = (a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
forall a b.
(a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
liftExtended (a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
~~ -a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0) (\a
x -> a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
~~ a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
> a
high) ((a -> b) -> a -> Extended b) -> (a -> b) -> a -> Extended b
forall a b. (a -> b) -> a -> b
$ \a
x -> if a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
< a
low then b
forall a. Bounded a => a
minBound else a -> b
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling a
x

    g :: Extended b -> a
g = a -> a -> (b -> a) -> Extended b -> a
forall b a. b -> b -> (a -> b) -> Extended a -> b
extended (-a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0) (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0) b -> a
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral

    h :: a -> Extended b
h = (a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
forall a b.
(a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
liftExtended (\a
x -> a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
~~ a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
< a
low) (a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
~~ a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0) ((a -> b) -> a -> Extended b) -> (a -> b) -> a -> Extended b
forall a b. (a -> b) -> a -> b
$ \a
x -> if a
x a -> a -> Bool
forall a. Preorder a => a -> a -> Bool
> a
high then b
forall a. Bounded a => a
maxBound else a -> b
forall a b. (RealFrac a, Integral b) => a -> b
P.floor a
x

    low :: a
low = -a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
high

{-
-- | Exact embedding up to the largest representable 'Int32'.
f32i32 :: ConnL Float (Maybe Int32)
f32i32 = Conn (nanf f) (nan g) where
  f x | abs x <~ 2**24-1 = P.ceiling x
      | otherwise = if x >~ 0 then 2^24 else minBound

  g i | abs' i <~ 2^24-1 = fromIntegral i
      | otherwise = if i >~ 0 then 1/0 else -2**24

-- | Exact embedding up to the largest representable 'Int32'.
i32f32 :: ConnL (Maybe Int32) Float
i32f32 = Conn (nan g) (nanf f) where
  f x | abs x <~ 2**24-1 = P.floor x
      | otherwise = if x >~ 0 then maxBound else -2^24

  g i | abs i <~ 2^24-1 = fromIntegral i
      | otherwise = if i >~ 0 then 2**24 else -1/0

-- | Exact embedding up to the largest representable 'Int64'.
f64i64 :: Conn Double (Maybe Int64)
f64i64 = Conn (nanf f) (nan g) where
  f x | abs x <~ 2**53-1 = P.ceiling x
      | otherwise = if x >~ 0 then 2^53 else minBound

  g i | abs' i <~ 2^53-1 = fromIntegral i
      | otherwise = if i >~ 0 then 1/0 else -2**53

-- | Exact embedding up to the largest representable 'Int64'.
f64ixx :: Conn Double (Maybe Int)
f64ixx = Conn (nanf f) (nan g) where
  f x | abs x <~ 2**53-1 = P.ceiling x
      | otherwise = if x >~ 0 then 2^53 else minBound

  g i | abs' i <~ 2^53-1 = fromIntegral i
      | otherwise = if i >~ 0 then 1/0 else -2**53
-}