{-#
    LANGUAGE
      BangPatterns,
      MagicHash,
      UnboxedTuples,
      UnliftedNewtypes
  #-}

-- | Real numbers in [0,1), represented as fixed-point reals stored in
-- a machine word.
--
-- `Fractional` would arguably be a better name, but is of course
-- already in use.
module Numeric.Mantissa (
  Mantissa(..),
  oneMinusE,
  mantissaFromWord,
  mantissaToWord,
  mantissaToFractional,
  ) where

import Data.Ratio ((%), numerator, denominator)
import GHC.Num (integerToWord, integerFromWord)
import GHC.Exts (Word(..), isTrue#, not#)
import Numeric.Mantissa.Unboxed


-- | A real number in [0,1), represented as a boxed word
data Mantissa = M# Mantissa#

-- | The largest possible mantissa, just a tiny bit less than one
oneMinusE :: Mantissa
oneMinusE :: Mantissa
oneMinusE = Mantissa# -> Mantissa
M# (Word# -> Mantissa#
Mantissa# (Word# -> Word#
not# Word#
0##))

instance Num Mantissa where

  -- | Addition is modulo 1
  M# Mantissa#
a + :: Mantissa -> Mantissa -> Mantissa
+ M# Mantissa#
b = Mantissa# -> Mantissa
M# (Mantissa# -> Mantissa# -> Mantissa#
plusMod1Mantissa# Mantissa#
a Mantissa#
b)
  
  -- | Subtraction is modulo 1
  M# Mantissa#
a - :: Mantissa -> Mantissa -> Mantissa
- M# Mantissa#
b = Mantissa# -> Mantissa
M# (Mantissa# -> Mantissa# -> Mantissa#
minusMod1Mantissa# Mantissa#
a Mantissa#
b)

  M# Mantissa#
a * :: Mantissa -> Mantissa -> Mantissa
* M# Mantissa#
b = Mantissa# -> Mantissa
M# (Mantissa# -> Mantissa# -> Mantissa#
timesMantissa# Mantissa#
a Mantissa#
b)

  -- | All mantissas are positive, so `abs` is the identity function
  abs :: Mantissa -> Mantissa
abs = Mantissa -> Mantissa
forall a. a -> a
id

  -- | The only integer representable as a mantissa is 0
  fromInteger :: Integer -> Mantissa
fromInteger Integer
0 = Mantissa# -> Mantissa
M# (Word# -> Mantissa#
Mantissa# Word#
0##)
  fromInteger Integer
_ = [Char] -> Mantissa
forall a. HasCallStack => [Char] -> a
error [Char]
"fromInteger: can only convert 0 to mantissa"

  -- | Note that `signum` does not return 1 for positive numbers,
  -- since 1 is not available
  signum :: Mantissa -> Mantissa
signum Mantissa
0 = Mantissa
0
  signum Mantissa
_ = Mantissa
oneMinusE

instance Eq Mantissa where
  M# Mantissa#
a == :: Mantissa -> Mantissa -> Bool
== M# Mantissa#
b = Int# -> Bool
isTrue# (Mantissa# -> Mantissa# -> Int#
eqMantissa# Mantissa#
a Mantissa#
b)

instance Ord Mantissa where
  M# Mantissa#
a < :: Mantissa -> Mantissa -> Bool
< M# Mantissa#
b = Int# -> Bool
isTrue# (Mantissa# -> Mantissa# -> Int#
ltMantissa# Mantissa#
a Mantissa#
b)
  M# Mantissa#
a > :: Mantissa -> Mantissa -> Bool
> M# Mantissa#
b = Int# -> Bool
isTrue# (Mantissa# -> Mantissa# -> Int#
gtMantissa# Mantissa#
a Mantissa#
b)
  M# Mantissa#
a <= :: Mantissa -> Mantissa -> Bool
<= M# Mantissa#
b = Int# -> Bool
isTrue# (Mantissa# -> Mantissa# -> Int#
leMantissa# Mantissa#
a Mantissa#
b)
  M# Mantissa#
a >= :: Mantissa -> Mantissa -> Bool
>= M# Mantissa#
b = Int# -> Bool
isTrue# (Mantissa# -> Mantissa# -> Int#
geMantissa# Mantissa#
a Mantissa#
b)

mantissaFromWord :: Word -> Mantissa
mantissaFromWord :: Word -> Mantissa
mantissaFromWord (W# Word#
w) = Mantissa# -> Mantissa
M# (Word# -> Mantissa#
Mantissa# Word#
w)

mantissaToWord :: Mantissa -> Word
mantissaToWord :: Mantissa -> Word
mantissaToWord (M# (Mantissa# Word#
w)) = Word# -> Word
W# Word#
w

-- | The unsigned integer stored in a mantissa ("what multiple of the
-- smallest possible mantissa is this?"). This is used as a step in
-- some more mathematically meaningful functionality.
mantissaSerial :: Mantissa -> Integer
mantissaSerial :: Mantissa -> Integer
mantissaSerial = Word -> Integer
integerFromWord (Word -> Integer) -> (Mantissa -> Word) -> Mantissa -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mantissa -> Word
mantissaToWord

-- | One more than the largest integer in a word (2^64 on a 64-bit
-- machine, for example).
--
-- I'd be interested to know if there's a more idiomatic way of doing
-- this.
wordMultiple :: Integer
wordMultiple :: Integer
wordMultiple = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Mantissa -> Integer
mantissaSerial Mantissa
oneMinusE

instance Fractional Mantissa where

  -- | The user is responsible for ensuring that, when they take a/b,
  -- then a is less than b.
  M# Mantissa#
a / :: Mantissa -> Mantissa -> Mantissa
/ M# Mantissa#
b = Mantissa# -> Mantissa
M# (Mantissa# -> Mantissa# -> Mantissa#
quotMantissa# Mantissa#
a Mantissa#
b)

  recip :: Mantissa -> Mantissa
recip Mantissa
_ = [Char] -> Mantissa
forall a. HasCallStack => [Char] -> a
error [Char]
"recip: cannot take reciprocal of a mantissa"

  -- | The user is responsible for ensuring that, when they use
  -- fromRational on a fraction, the numerator is less than the
  -- denominator (and both are positive).
  fromRational :: Rational -> Mantissa
fromRational Rational
u = let
    q :: Integer
q = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot (Integer
wordMultiple Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Rational -> Integer
forall a. Ratio a -> a
numerator Rational
u) (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
u)
    in Word -> Mantissa
mantissaFromWord (Integer -> Word
integerToWord Integer
q)

-- | Convert a mantissa to any Fractional type, implemented using
-- `fromRational`
mantissaToFractional :: Fractional a => Mantissa -> a
mantissaToFractional :: forall a. Fractional a => Mantissa -> a
mantissaToFractional Mantissa
m = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Mantissa -> Integer
mantissaSerial Mantissa
m Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
wordMultiple)