% Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
% 
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% any later version.
% 
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
% 
% You should have received a copy of the GNU General Public License
% along with this program.  If not, see <http://www.gnu.org/licenses/>.

\ignore{
\begin{code}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Binary.IEEE754 (
    -- * Parsing
      getFloat16be, getFloat16le
    , getFloat32be, getFloat32le
    , getFloat64be, getFloat64le

    -- * Serializing
    , putFloat32be, putFloat32le
    , putFloat64be, putFloat64le
) where

import Data.Bits ((.&.), (.|.), shiftL, shiftR, Bits)
import Data.Word (Word8)
import Data.List (foldl')

import qualified Data.ByteString as B
import Data.Binary.Get (Get, getByteString)
import Data.Binary.Put (Put, putByteString)
\end{code}
}

\section{Parsing}

\subsection{Public interface}

\begin{code}
getFloat16be :: Get Float
getFloat16be :: Get Float
getFloat16be = ByteCount -> ([Word8] -> RawFloat) -> Get Float
forall a.
(Read a, RealFloat a) =>
ByteCount -> ([Word8] -> RawFloat) -> Get a
getFloat (Int -> ByteCount
ByteCount Int
2) [Word8] -> RawFloat
splitBytes
\end{code}

\begin{code}
getFloat16le :: Get Float
getFloat16le :: Get Float
getFloat16le = ByteCount -> ([Word8] -> RawFloat) -> Get Float
forall a.
(Read a, RealFloat a) =>
ByteCount -> ([Word8] -> RawFloat) -> Get a
getFloat (Int -> ByteCount
ByteCount Int
2) (([Word8] -> RawFloat) -> Get Float)
-> ([Word8] -> RawFloat) -> Get Float
forall a b. (a -> b) -> a -> b
$ [Word8] -> RawFloat
splitBytes ([Word8] -> RawFloat)
-> ([Word8] -> [Word8]) -> [Word8] -> RawFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
\end{code}

\begin{code}
getFloat32be :: Get Float
getFloat32be :: Get Float
getFloat32be = ByteCount -> ([Word8] -> RawFloat) -> Get Float
forall a.
(Read a, RealFloat a) =>
ByteCount -> ([Word8] -> RawFloat) -> Get a
getFloat (Int -> ByteCount
ByteCount Int
4) [Word8] -> RawFloat
splitBytes
\end{code}

\begin{code}
getFloat32le :: Get Float
getFloat32le :: Get Float
getFloat32le = ByteCount -> ([Word8] -> RawFloat) -> Get Float
forall a.
(Read a, RealFloat a) =>
ByteCount -> ([Word8] -> RawFloat) -> Get a
getFloat (Int -> ByteCount
ByteCount Int
4) (([Word8] -> RawFloat) -> Get Float)
-> ([Word8] -> RawFloat) -> Get Float
forall a b. (a -> b) -> a -> b
$ [Word8] -> RawFloat
splitBytes ([Word8] -> RawFloat)
-> ([Word8] -> [Word8]) -> [Word8] -> RawFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
\end{code}

\begin{code}
getFloat64be :: Get Double
getFloat64be :: Get Double
getFloat64be = ByteCount -> ([Word8] -> RawFloat) -> Get Double
forall a.
(Read a, RealFloat a) =>
ByteCount -> ([Word8] -> RawFloat) -> Get a
getFloat (Int -> ByteCount
ByteCount Int
8) [Word8] -> RawFloat
splitBytes
\end{code}

\begin{code}
getFloat64le :: Get Double
getFloat64le :: Get Double
getFloat64le = ByteCount -> ([Word8] -> RawFloat) -> Get Double
forall a.
(Read a, RealFloat a) =>
ByteCount -> ([Word8] -> RawFloat) -> Get a
getFloat (Int -> ByteCount
ByteCount Int
8) (([Word8] -> RawFloat) -> Get Double)
-> ([Word8] -> RawFloat) -> Get Double
forall a b. (a -> b) -> a -> b
$ [Word8] -> RawFloat
splitBytes ([Word8] -> RawFloat)
-> ([Word8] -> [Word8]) -> [Word8] -> RawFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
\end{code}

\subsection{Implementation}

Split the raw byte array into (sign, exponent, significand) components.
The exponent and signifcand are drawn directly from the bits in the
original float, and have not been unbiased or otherwise modified.

\begin{code}
splitBytes :: [Word8] -> RawFloat
splitBytes :: [Word8] -> RawFloat
splitBytes [Word8]
bs = ByteCount
-> Sign
-> Exponent
-> Significand
-> BitCount
-> BitCount
-> RawFloat
RawFloat ByteCount
width Sign
sign Exponent
exp' Significand
sig BitCount
expWidth BitCount
sigWidth where
    width :: ByteCount
width = Int -> ByteCount
ByteCount ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bs)
    nBits :: BitCount
nBits = [Word8] -> BitCount
bitsInWord8 [Word8]
bs
    sign :: Sign
sign = if [Word8] -> Word8
forall a. [a] -> a
head [Word8]
bs Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80
             then Sign
Negative
             else Sign
Positive

    expStart :: BitCount
expStart = BitCount
1
    expWidth :: BitCount
expWidth = BitCount -> BitCount
exponentWidth BitCount
nBits
    expEnd :: BitCount
expEnd = BitCount
expStart BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
+ BitCount
expWidth
    exp' :: Exponent
exp' = Int -> Exponent
Exponent (Int -> Exponent) -> (Integer -> Int) -> Integer -> Exponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Exponent) -> Integer -> Exponent
forall a b. (a -> b) -> a -> b
$ [Word8] -> BitCount -> BitCount -> Integer
bitSlice [Word8]
bs BitCount
expStart BitCount
expEnd

    sigWidth :: BitCount
sigWidth = BitCount
nBits BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
expEnd
    sig :: Significand
sig  = Integer -> Significand
Significand (Integer -> Significand) -> Integer -> Significand
forall a b. (a -> b) -> a -> b
$ [Word8] -> BitCount -> BitCount -> Integer
bitSlice [Word8]
bs BitCount
expEnd BitCount
nBits
\end{code}

\subsubsection{Encodings and special values}

The next step depends on the value of the exponent $e$, size of the
exponent field in bits $w$, and value of the significand.

\begin{table}[h]
\begin{center}
\begin{tabular}{lrl}
\toprule
Exponent                & Significand & Format \\
\midrule
$0$                     & $0$           & Zero \\
$0$                     & $> 0$         & Denormalised \\
$1 \leq e \leq 2^w - 2$ & \textit{any} & Normalised \\
$2^w-1$                 & $0$           & Infinity \\
$2^w-1$                 & $> 0$         & NaN \\
\bottomrule
\end{tabular}
\end{center}
\end{table}

There's no built-in literals for Infinity or NaN, so they
are constructed using the {\tt Read} instances for {\tt Double} and
{\tt Float}.

\begin{code}
merge :: (Read a, RealFloat a) => RawFloat -> a
merge :: RawFloat -> a
merge f :: RawFloat
f@(RawFloat ByteCount
_ Sign
_ Exponent
e Significand
sig BitCount
eWidth BitCount
_)
    | Exponent
e Exponent -> Exponent -> Bool
forall a. Eq a => a -> a -> Bool
== Exponent
0 = if Significand
sig Significand -> Significand -> Bool
forall a. Eq a => a -> a -> Bool
== Significand
0
                 then a
0.0
                 else RawFloat -> a
forall a. RealFloat a => RawFloat -> a
denormalised RawFloat
f
    | Exponent
e Exponent -> Exponent -> Bool
forall a. Eq a => a -> a -> Bool
== Exponent
eMax Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
- Exponent
1 = if Significand
sig Significand -> Significand -> Bool
forall a. Eq a => a -> a -> Bool
== Significand
0
                        then String -> a
forall a. Read a => String -> a
read String
"Infinity"
                        else String -> a
forall a. Read a => String -> a
read String
"NaN"
    | Bool
otherwise = RawFloat -> a
forall a. RealFloat a => RawFloat -> a
normalised RawFloat
f
    where eMax :: Exponent
eMax = Integer
2 Integer -> BitCount -> Exponent
forall a b c. (Integral a, Integral b, Integral c) => a -> b -> c
`pow` BitCount
eWidth
\end{code}

If a value is normalised, its significand has an implied {\tt 1} bit
in its most-significant bit. The significand must be adjusted by
this value before being passed to {\tt encodeField}.

\begin{code}
normalised :: RealFloat a => RawFloat -> a
normalised :: RawFloat -> a
normalised RawFloat
f = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
fraction Int
exp' where
    Significand Integer
sig = RawFloat -> Significand
rawSignificand RawFloat
f
    Exponent Int
exp' = Exponent
unbiased Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
- Exponent
sigWidth

    fraction :: Integer
fraction = Integer
sig Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
1 Integer -> BitCount -> Integer
forall a. Bits a => a -> BitCount -> a
`bitShiftL` RawFloat -> BitCount
rawSignificandWidth RawFloat
f)

    sigWidth :: Exponent
sigWidth = BitCount -> Exponent
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BitCount -> Exponent) -> BitCount -> Exponent
forall a b. (a -> b) -> a -> b
$ RawFloat -> BitCount
rawSignificandWidth RawFloat
f
    unbiased :: Exponent
unbiased = Exponent -> BitCount -> Exponent
unbias (RawFloat -> Exponent
rawExponent RawFloat
f) (RawFloat -> BitCount
rawExponentWidth RawFloat
f)
\end{code}

For denormalised values, the implied {\tt 1} bit is the least-significant
bit of the exponent.

\begin{code}
denormalised :: RealFloat a => RawFloat -> a
denormalised :: RawFloat -> a
denormalised RawFloat
f = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
sig Int
exp' where
    Significand Integer
sig = RawFloat -> Significand
rawSignificand RawFloat
f
    Exponent Int
exp' = Exponent
unbiased Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
- Exponent
sigWidth Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
+ Exponent
1

    sigWidth :: Exponent
sigWidth = BitCount -> Exponent
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BitCount -> Exponent) -> BitCount -> Exponent
forall a b. (a -> b) -> a -> b
$ RawFloat -> BitCount
rawSignificandWidth RawFloat
f
    unbiased :: Exponent
unbiased = Exponent -> BitCount -> Exponent
unbias (RawFloat -> Exponent
rawExponent RawFloat
f) (RawFloat -> BitCount
rawExponentWidth RawFloat
f)
\end{code}

By composing {\tt splitBytes} and {\tt merge}, the absolute value of the
float is calculated. Before being returned to the calling function, it
must be signed appropriately.

\begin{code}
getFloat :: (Read a, RealFloat a) => ByteCount
            -> ([Word8] -> RawFloat) -> Get a
getFloat :: ByteCount -> ([Word8] -> RawFloat) -> Get a
getFloat (ByteCount Int
width) [Word8] -> RawFloat
parser = do
    RawFloat
raw <- (ByteString -> RawFloat) -> Get ByteString -> Get RawFloat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Word8] -> RawFloat
parser ([Word8] -> RawFloat)
-> (ByteString -> [Word8]) -> ByteString -> RawFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack) (Get ByteString -> Get RawFloat) -> Get ByteString -> Get RawFloat
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString Int
width
    let absFloat :: a
absFloat = RawFloat -> a
forall a. (Read a, RealFloat a) => RawFloat -> a
merge RawFloat
raw
    a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ case RawFloat -> Sign
rawSign RawFloat
raw of
               Sign
Positive ->  a
absFloat
               Sign
Negative -> -a
absFloat
\end{code}

\section{Serialising}

\subsection{Public interface}

\begin{code}
putFloat32be :: Float -> Put
putFloat32be :: Float -> Put
putFloat32be = ByteCount -> ([Word8] -> [Word8]) -> Float -> Put
forall a.
RealFloat a =>
ByteCount -> ([Word8] -> [Word8]) -> a -> Put
putFloat (Int -> ByteCount
ByteCount Int
4) [Word8] -> [Word8]
forall a. a -> a
id
\end{code}

\begin{code}
putFloat32le :: Float -> Put
putFloat32le :: Float -> Put
putFloat32le = ByteCount -> ([Word8] -> [Word8]) -> Float -> Put
forall a.
RealFloat a =>
ByteCount -> ([Word8] -> [Word8]) -> a -> Put
putFloat (Int -> ByteCount
ByteCount Int
4) [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
\end{code}

\begin{code}
putFloat64be :: Double -> Put
putFloat64be :: Double -> Put
putFloat64be = ByteCount -> ([Word8] -> [Word8]) -> Double -> Put
forall a.
RealFloat a =>
ByteCount -> ([Word8] -> [Word8]) -> a -> Put
putFloat (Int -> ByteCount
ByteCount Int
8) [Word8] -> [Word8]
forall a. a -> a
id
\end{code}

\begin{code}
putFloat64le :: Double -> Put
putFloat64le :: Double -> Put
putFloat64le = ByteCount -> ([Word8] -> [Word8]) -> Double -> Put
forall a.
RealFloat a =>
ByteCount -> ([Word8] -> [Word8]) -> a -> Put
putFloat (Int -> ByteCount
ByteCount Int
8) [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
\end{code}

\subsection{Implementation}

Serialisation is similar to parsing. First, the float is converted to
a structure representing raw bitfields. The values returned from
{\tt decodeFloat} are clamped to their expected lengths before being
stored in the {\tt RawFloat}.

\begin{code}
splitFloat :: RealFloat a => ByteCount -> a -> RawFloat
splitFloat :: ByteCount -> a -> RawFloat
splitFloat ByteCount
width a
x = RawFloat
raw where
    raw :: RawFloat
raw = ByteCount
-> Sign
-> Exponent
-> Significand
-> BitCount
-> BitCount
-> RawFloat
RawFloat ByteCount
width Sign
sign Exponent
clampedExp Significand
clampedSig BitCount
expWidth BitCount
sigWidth
    sign :: Sign
sign = if a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
             then Sign
Negative
             else Sign
Positive
    clampedExp :: Exponent
clampedExp = BitCount -> Exponent -> Exponent
forall a. (Num a, Bits a) => BitCount -> a -> a
clamp BitCount
expWidth Exponent
exp'
    clampedSig :: Significand
clampedSig = BitCount -> Significand -> Significand
forall a. (Num a, Bits a) => BitCount -> a -> a
clamp BitCount
sigWidth Significand
sig
    (Exponent
exp', Significand
sig) = case (Integer
dFraction, Int
dExponent, Exponent
biasedExp) of
                    (Integer
0, Int
0, Exponent
_) -> (Exponent
0, Significand
0)
                    (Integer
_, Int
_, Exponent
0) -> (Exponent
0, Integer -> Significand
Significand (Integer -> Significand) -> Integer -> Significand
forall a b. (a -> b) -> a -> b
$ Integer
truncatedSig Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
                    (Integer, Int, Exponent)
_         -> (Exponent
biasedExp, Integer -> Significand
Significand Integer
truncatedSig)
    expWidth :: BitCount
expWidth = BitCount -> BitCount
exponentWidth (BitCount -> BitCount) -> BitCount -> BitCount
forall a b. (a -> b) -> a -> b
$ ByteCount -> BitCount
bitCount ByteCount
width
    sigWidth :: BitCount
sigWidth = ByteCount -> BitCount
bitCount ByteCount
width BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
expWidth BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
1 -- 1 for sign bit

    (Integer
dFraction, Int
dExponent) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x

    rawExp :: Exponent
rawExp = Int -> Exponent
Exponent (Int -> Exponent) -> Int -> Exponent
forall a b. (a -> b) -> a -> b
$ Int
dExponent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ BitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
sigWidth
    biasedExp :: Exponent
biasedExp = Exponent -> BitCount -> Exponent
bias Exponent
rawExp BitCount
expWidth
    truncatedSig :: Integer
truncatedSig = Integer -> Integer
forall a. Num a => a -> a
abs Integer
dFraction Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
1 Integer -> BitCount -> Integer
forall a. Bits a => a -> BitCount -> a
`bitShiftL` BitCount
sigWidth)
\end{code}

Then, the {\tt RawFloat} is converted to a list of bytes by mashing all
the fields together into an {\tt Integer}, and chopping up that integer
in 8-bit blocks.

\begin{code}
rawToBytes :: RawFloat -> [Word8]
rawToBytes :: RawFloat -> [Word8]
rawToBytes RawFloat
raw = Integer -> ByteCount -> [Word8]
integerToBytes Integer
mashed ByteCount
width where
    RawFloat ByteCount
width Sign
sign Exponent
exp' Significand
sig BitCount
expWidth BitCount
sigWidth = RawFloat
raw
    sign' :: Word8
    sign' :: Word8
sign' = case Sign
sign of
              Sign
Positive -> Word8
0
              Sign
Negative -> Word8
1
    mashed :: Integer
mashed = Significand -> BitCount -> Integer -> Integer
forall a.
(Bits a, Integral a) =>
a -> BitCount -> Integer -> Integer
mashBits Significand
sig BitCount
sigWidth (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Exponent -> BitCount -> Integer -> Integer
forall a.
(Bits a, Integral a) =>
a -> BitCount -> Integer -> Integer
mashBits Exponent
exp' BitCount
expWidth (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Word8 -> BitCount -> Integer -> Integer
forall a.
(Bits a, Integral a) =>
a -> BitCount -> Integer -> Integer
mashBits Word8
sign' BitCount
1 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
0
\end{code}

{\tt clamp}, given a maximum bit count and a value, will strip any 1-bits
in positions above the count.

\begin{code}
clamp :: (Num a, Bits a) => BitCount -> a -> a
clamp :: BitCount -> a -> a
clamp = a -> a -> a
forall a. Bits a => a -> a -> a
(.&.) (a -> a -> a) -> (BitCount -> a) -> BitCount -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitCount -> a
forall t p. (Num t, Num p, Ord t, Bits p) => t -> p
mask where
    mask :: t -> p
mask t
1 = p
1
    mask t
n | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
1 = (t -> p
mask (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) p -> Int -> p
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) p -> p -> p
forall a. Num a => a -> a -> a
+ p
1
    mask t
_ = p
forall a. HasCallStack => a
undefined
\end{code}

For merging the fields, just shift the starting integer over a bit and
then \textsc{or} it with the next value. The weird parameter order allows
easy composition.

\begin{code}
mashBits :: (Bits a, Integral a) => a -> BitCount -> Integer -> Integer
mashBits :: a -> BitCount -> Integer -> Integer
mashBits a
_ BitCount
0 Integer
x = Integer
x
mashBits a
y BitCount
n Integer
x = (Integer
x Integer -> BitCount -> Integer
forall a. Bits a => a -> BitCount -> a
`bitShiftL` BitCount
n) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y
\end{code}

Given an integer, read it in 255-block increments starting from the LSB.
Each increment is converted to a byte and added to the final list.

\begin{code}
integerToBytes :: Integer -> ByteCount -> [Word8]
integerToBytes :: Integer -> ByteCount -> [Word8]
integerToBytes Integer
_ ByteCount
0 = []
integerToBytes Integer
x ByteCount
n = [Word8]
bytes where
    bytes :: [Word8]
bytes = Integer -> ByteCount -> [Word8]
integerToBytes (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) (ByteCount
n ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
- ByteCount
1) [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
step]
    step :: Word8
step = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF
\end{code}

Finally, the raw parsing is wrapped up in {\tt Put}. The second parameter
allows the same code paths to be used for little- and big-endian
serialisation.

\begin{code}
putFloat :: (RealFloat a) => ByteCount -> ([Word8] -> [Word8]) -> a -> Put
putFloat :: ByteCount -> ([Word8] -> [Word8]) -> a -> Put
putFloat ByteCount
width [Word8] -> [Word8]
f a
x = ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8]
bytes where
    bytes :: [Word8]
bytes = [Word8] -> [Word8]
f ([Word8] -> [Word8]) -> (a -> [Word8]) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFloat -> [Word8]
rawToBytes (RawFloat -> [Word8]) -> (a -> RawFloat) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteCount -> a -> RawFloat
forall a. RealFloat a => ByteCount -> a -> RawFloat
splitFloat ByteCount
width (a -> [Word8]) -> a -> [Word8]
forall a b. (a -> b) -> a -> b
$ a
x
\end{code}

\section{Raw float components}

Information about the raw bit patterns in the float is stored in
{\tt RawFloat}, so they don't have to be passed around to the various
format cases. The exponent should be biased, and the significand
shouldn't have it's implied MSB (if applicable).

\begin{code}
data RawFloat = RawFloat
    { RawFloat -> ByteCount
rawWidth            :: ByteCount
    , RawFloat -> Sign
rawSign             :: Sign
    , RawFloat -> Exponent
rawExponent         :: Exponent
    , RawFloat -> Significand
rawSignificand      :: Significand
    , RawFloat -> BitCount
rawExponentWidth    :: BitCount
    , RawFloat -> BitCount
rawSignificandWidth :: BitCount
    }
    deriving (Int -> RawFloat -> ShowS
[RawFloat] -> ShowS
RawFloat -> String
(Int -> RawFloat -> ShowS)
-> (RawFloat -> String) -> ([RawFloat] -> ShowS) -> Show RawFloat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawFloat] -> ShowS
$cshowList :: [RawFloat] -> ShowS
show :: RawFloat -> String
$cshow :: RawFloat -> String
showsPrec :: Int -> RawFloat -> ShowS
$cshowsPrec :: Int -> RawFloat -> ShowS
Show)
\end{code}

\section{Exponents}

Calculate the proper size of the exponent field, in bits, given the
size of the full structure.

\begin{code}
exponentWidth :: BitCount -> BitCount
exponentWidth :: BitCount -> BitCount
exponentWidth BitCount
k
    | BitCount
k BitCount -> BitCount -> Bool
forall a. Eq a => a -> a -> Bool
== BitCount
16         = BitCount
5
    | BitCount
k BitCount -> BitCount -> Bool
forall a. Eq a => a -> a -> Bool
== BitCount
32         = BitCount
8
    | BitCount
k BitCount -> BitCount -> BitCount
forall a. Integral a => a -> a -> a
`mod` BitCount
32 BitCount -> BitCount -> Bool
forall a. Eq a => a -> a -> Bool
== BitCount
0 = Double -> BitCount
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (BitCount -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
k)) BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
13
    | Bool
otherwise       = String -> BitCount
forall a. HasCallStack => String -> a
error String
"Invalid length of floating-point value"
\end{code}

\begin{code}
bias :: Exponent -> BitCount -> Exponent
bias :: Exponent -> BitCount -> Exponent
bias Exponent
e BitCount
eWidth = Exponent
e Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
- (Exponent
1 Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
- (Integer
2 Integer -> BitCount -> Exponent
forall a b c. (Integral a, Integral b, Integral c) => a -> b -> c
`pow` (BitCount
eWidth BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
1)))
\end{code}

\begin{code}
unbias :: Exponent -> BitCount -> Exponent
unbias :: Exponent -> BitCount -> Exponent
unbias Exponent
e BitCount
eWidth = Exponent
e Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
+ Exponent
1 Exponent -> Exponent -> Exponent
forall a. Num a => a -> a -> a
- (Integer
2 Integer -> BitCount -> Exponent
forall a b c. (Integral a, Integral b, Integral c) => a -> b -> c
`pow` (BitCount
eWidth BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
1))
\end{code}

\section{Byte and bit counting}

\begin{code}
data Sign = Positive | Negative
    deriving (Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show)

newtype Exponent = Exponent Int
    deriving (Int -> Exponent -> ShowS
[Exponent] -> ShowS
Exponent -> String
(Int -> Exponent -> ShowS)
-> (Exponent -> String) -> ([Exponent] -> ShowS) -> Show Exponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exponent] -> ShowS
$cshowList :: [Exponent] -> ShowS
show :: Exponent -> String
$cshow :: Exponent -> String
showsPrec :: Int -> Exponent -> ShowS
$cshowsPrec :: Int -> Exponent -> ShowS
Show, Exponent -> Exponent -> Bool
(Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool) -> Eq Exponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exponent -> Exponent -> Bool
$c/= :: Exponent -> Exponent -> Bool
== :: Exponent -> Exponent -> Bool
$c== :: Exponent -> Exponent -> Bool
Eq, Integer -> Exponent
Exponent -> Exponent
Exponent -> Exponent -> Exponent
(Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent)
-> (Exponent -> Exponent)
-> (Exponent -> Exponent)
-> (Integer -> Exponent)
-> Num Exponent
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Exponent
$cfromInteger :: Integer -> Exponent
signum :: Exponent -> Exponent
$csignum :: Exponent -> Exponent
abs :: Exponent -> Exponent
$cabs :: Exponent -> Exponent
negate :: Exponent -> Exponent
$cnegate :: Exponent -> Exponent
* :: Exponent -> Exponent -> Exponent
$c* :: Exponent -> Exponent -> Exponent
- :: Exponent -> Exponent -> Exponent
$c- :: Exponent -> Exponent -> Exponent
+ :: Exponent -> Exponent -> Exponent
$c+ :: Exponent -> Exponent -> Exponent
Num, Eq Exponent
Eq Exponent
-> (Exponent -> Exponent -> Ordering)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> Ord Exponent
Exponent -> Exponent -> Bool
Exponent -> Exponent -> Ordering
Exponent -> Exponent -> Exponent
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
min :: Exponent -> Exponent -> Exponent
$cmin :: Exponent -> Exponent -> Exponent
max :: Exponent -> Exponent -> Exponent
$cmax :: Exponent -> Exponent -> Exponent
>= :: Exponent -> Exponent -> Bool
$c>= :: Exponent -> Exponent -> Bool
> :: Exponent -> Exponent -> Bool
$c> :: Exponent -> Exponent -> Bool
<= :: Exponent -> Exponent -> Bool
$c<= :: Exponent -> Exponent -> Bool
< :: Exponent -> Exponent -> Bool
$c< :: Exponent -> Exponent -> Bool
compare :: Exponent -> Exponent -> Ordering
$ccompare :: Exponent -> Exponent -> Ordering
$cp1Ord :: Eq Exponent
Ord, Num Exponent
Ord Exponent
Num Exponent
-> Ord Exponent -> (Exponent -> Rational) -> Real Exponent
Exponent -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Exponent -> Rational
$ctoRational :: Exponent -> Rational
$cp2Real :: Ord Exponent
$cp1Real :: Num Exponent
Real, Int -> Exponent
Exponent -> Int
Exponent -> [Exponent]
Exponent -> Exponent
Exponent -> Exponent -> [Exponent]
Exponent -> Exponent -> Exponent -> [Exponent]
(Exponent -> Exponent)
-> (Exponent -> Exponent)
-> (Int -> Exponent)
-> (Exponent -> Int)
-> (Exponent -> [Exponent])
-> (Exponent -> Exponent -> [Exponent])
-> (Exponent -> Exponent -> [Exponent])
-> (Exponent -> Exponent -> Exponent -> [Exponent])
-> Enum Exponent
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Exponent -> Exponent -> Exponent -> [Exponent]
$cenumFromThenTo :: Exponent -> Exponent -> Exponent -> [Exponent]
enumFromTo :: Exponent -> Exponent -> [Exponent]
$cenumFromTo :: Exponent -> Exponent -> [Exponent]
enumFromThen :: Exponent -> Exponent -> [Exponent]
$cenumFromThen :: Exponent -> Exponent -> [Exponent]
enumFrom :: Exponent -> [Exponent]
$cenumFrom :: Exponent -> [Exponent]
fromEnum :: Exponent -> Int
$cfromEnum :: Exponent -> Int
toEnum :: Int -> Exponent
$ctoEnum :: Int -> Exponent
pred :: Exponent -> Exponent
$cpred :: Exponent -> Exponent
succ :: Exponent -> Exponent
$csucc :: Exponent -> Exponent
Enum, Enum Exponent
Real Exponent
Real Exponent
-> Enum Exponent
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> (Exponent, Exponent))
-> (Exponent -> Exponent -> (Exponent, Exponent))
-> (Exponent -> Integer)
-> Integral Exponent
Exponent -> Integer
Exponent -> Exponent -> (Exponent, Exponent)
Exponent -> Exponent -> Exponent
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Exponent -> Integer
$ctoInteger :: Exponent -> Integer
divMod :: Exponent -> Exponent -> (Exponent, Exponent)
$cdivMod :: Exponent -> Exponent -> (Exponent, Exponent)
quotRem :: Exponent -> Exponent -> (Exponent, Exponent)
$cquotRem :: Exponent -> Exponent -> (Exponent, Exponent)
mod :: Exponent -> Exponent -> Exponent
$cmod :: Exponent -> Exponent -> Exponent
div :: Exponent -> Exponent -> Exponent
$cdiv :: Exponent -> Exponent -> Exponent
rem :: Exponent -> Exponent -> Exponent
$crem :: Exponent -> Exponent -> Exponent
quot :: Exponent -> Exponent -> Exponent
$cquot :: Exponent -> Exponent -> Exponent
$cp2Integral :: Enum Exponent
$cp1Integral :: Real Exponent
Integral, Eq Exponent
Exponent
Eq Exponent
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> Exponent
-> (Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Bool)
-> (Exponent -> Maybe Int)
-> (Exponent -> Int)
-> (Exponent -> Bool)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int -> Exponent)
-> (Exponent -> Int)
-> Bits Exponent
Int -> Exponent
Exponent -> Bool
Exponent -> Int
Exponent -> Maybe Int
Exponent -> Exponent
Exponent -> Int -> Bool
Exponent -> Int -> Exponent
Exponent -> Exponent -> Exponent
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
popCount :: Exponent -> Int
$cpopCount :: Exponent -> Int
rotateR :: Exponent -> Int -> Exponent
$crotateR :: Exponent -> Int -> Exponent
rotateL :: Exponent -> Int -> Exponent
$crotateL :: Exponent -> Int -> Exponent
unsafeShiftR :: Exponent -> Int -> Exponent
$cunsafeShiftR :: Exponent -> Int -> Exponent
shiftR :: Exponent -> Int -> Exponent
$cshiftR :: Exponent -> Int -> Exponent
unsafeShiftL :: Exponent -> Int -> Exponent
$cunsafeShiftL :: Exponent -> Int -> Exponent
shiftL :: Exponent -> Int -> Exponent
$cshiftL :: Exponent -> Int -> Exponent
isSigned :: Exponent -> Bool
$cisSigned :: Exponent -> Bool
bitSize :: Exponent -> Int
$cbitSize :: Exponent -> Int
bitSizeMaybe :: Exponent -> Maybe Int
$cbitSizeMaybe :: Exponent -> Maybe Int
testBit :: Exponent -> Int -> Bool
$ctestBit :: Exponent -> Int -> Bool
complementBit :: Exponent -> Int -> Exponent
$ccomplementBit :: Exponent -> Int -> Exponent
clearBit :: Exponent -> Int -> Exponent
$cclearBit :: Exponent -> Int -> Exponent
setBit :: Exponent -> Int -> Exponent
$csetBit :: Exponent -> Int -> Exponent
bit :: Int -> Exponent
$cbit :: Int -> Exponent
zeroBits :: Exponent
$czeroBits :: Exponent
rotate :: Exponent -> Int -> Exponent
$crotate :: Exponent -> Int -> Exponent
shift :: Exponent -> Int -> Exponent
$cshift :: Exponent -> Int -> Exponent
complement :: Exponent -> Exponent
$ccomplement :: Exponent -> Exponent
xor :: Exponent -> Exponent -> Exponent
$cxor :: Exponent -> Exponent -> Exponent
.|. :: Exponent -> Exponent -> Exponent
$c.|. :: Exponent -> Exponent -> Exponent
.&. :: Exponent -> Exponent -> Exponent
$c.&. :: Exponent -> Exponent -> Exponent
$cp1Bits :: Eq Exponent
Bits)

newtype Significand = Significand Integer
    deriving (Int -> Significand -> ShowS
[Significand] -> ShowS
Significand -> String
(Int -> Significand -> ShowS)
-> (Significand -> String)
-> ([Significand] -> ShowS)
-> Show Significand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Significand] -> ShowS
$cshowList :: [Significand] -> ShowS
show :: Significand -> String
$cshow :: Significand -> String
showsPrec :: Int -> Significand -> ShowS
$cshowsPrec :: Int -> Significand -> ShowS
Show, Significand -> Significand -> Bool
(Significand -> Significand -> Bool)
-> (Significand -> Significand -> Bool) -> Eq Significand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Significand -> Significand -> Bool
$c/= :: Significand -> Significand -> Bool
== :: Significand -> Significand -> Bool
$c== :: Significand -> Significand -> Bool
Eq, Integer -> Significand
Significand -> Significand
Significand -> Significand -> Significand
(Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand)
-> (Significand -> Significand)
-> (Significand -> Significand)
-> (Integer -> Significand)
-> Num Significand
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Significand
$cfromInteger :: Integer -> Significand
signum :: Significand -> Significand
$csignum :: Significand -> Significand
abs :: Significand -> Significand
$cabs :: Significand -> Significand
negate :: Significand -> Significand
$cnegate :: Significand -> Significand
* :: Significand -> Significand -> Significand
$c* :: Significand -> Significand -> Significand
- :: Significand -> Significand -> Significand
$c- :: Significand -> Significand -> Significand
+ :: Significand -> Significand -> Significand
$c+ :: Significand -> Significand -> Significand
Num, Eq Significand
Eq Significand
-> (Significand -> Significand -> Ordering)
-> (Significand -> Significand -> Bool)
-> (Significand -> Significand -> Bool)
-> (Significand -> Significand -> Bool)
-> (Significand -> Significand -> Bool)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> Ord Significand
Significand -> Significand -> Bool
Significand -> Significand -> Ordering
Significand -> Significand -> Significand
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
min :: Significand -> Significand -> Significand
$cmin :: Significand -> Significand -> Significand
max :: Significand -> Significand -> Significand
$cmax :: Significand -> Significand -> Significand
>= :: Significand -> Significand -> Bool
$c>= :: Significand -> Significand -> Bool
> :: Significand -> Significand -> Bool
$c> :: Significand -> Significand -> Bool
<= :: Significand -> Significand -> Bool
$c<= :: Significand -> Significand -> Bool
< :: Significand -> Significand -> Bool
$c< :: Significand -> Significand -> Bool
compare :: Significand -> Significand -> Ordering
$ccompare :: Significand -> Significand -> Ordering
$cp1Ord :: Eq Significand
Ord, Num Significand
Ord Significand
Num Significand
-> Ord Significand -> (Significand -> Rational) -> Real Significand
Significand -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Significand -> Rational
$ctoRational :: Significand -> Rational
$cp2Real :: Ord Significand
$cp1Real :: Num Significand
Real, Int -> Significand
Significand -> Int
Significand -> [Significand]
Significand -> Significand
Significand -> Significand -> [Significand]
Significand -> Significand -> Significand -> [Significand]
(Significand -> Significand)
-> (Significand -> Significand)
-> (Int -> Significand)
-> (Significand -> Int)
-> (Significand -> [Significand])
-> (Significand -> Significand -> [Significand])
-> (Significand -> Significand -> [Significand])
-> (Significand -> Significand -> Significand -> [Significand])
-> Enum Significand
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Significand -> Significand -> Significand -> [Significand]
$cenumFromThenTo :: Significand -> Significand -> Significand -> [Significand]
enumFromTo :: Significand -> Significand -> [Significand]
$cenumFromTo :: Significand -> Significand -> [Significand]
enumFromThen :: Significand -> Significand -> [Significand]
$cenumFromThen :: Significand -> Significand -> [Significand]
enumFrom :: Significand -> [Significand]
$cenumFrom :: Significand -> [Significand]
fromEnum :: Significand -> Int
$cfromEnum :: Significand -> Int
toEnum :: Int -> Significand
$ctoEnum :: Int -> Significand
pred :: Significand -> Significand
$cpred :: Significand -> Significand
succ :: Significand -> Significand
$csucc :: Significand -> Significand
Enum, Enum Significand
Real Significand
Real Significand
-> Enum Significand
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> (Significand, Significand))
-> (Significand -> Significand -> (Significand, Significand))
-> (Significand -> Integer)
-> Integral Significand
Significand -> Integer
Significand -> Significand -> (Significand, Significand)
Significand -> Significand -> Significand
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Significand -> Integer
$ctoInteger :: Significand -> Integer
divMod :: Significand -> Significand -> (Significand, Significand)
$cdivMod :: Significand -> Significand -> (Significand, Significand)
quotRem :: Significand -> Significand -> (Significand, Significand)
$cquotRem :: Significand -> Significand -> (Significand, Significand)
mod :: Significand -> Significand -> Significand
$cmod :: Significand -> Significand -> Significand
div :: Significand -> Significand -> Significand
$cdiv :: Significand -> Significand -> Significand
rem :: Significand -> Significand -> Significand
$crem :: Significand -> Significand -> Significand
quot :: Significand -> Significand -> Significand
$cquot :: Significand -> Significand -> Significand
$cp2Integral :: Enum Significand
$cp1Integral :: Real Significand
Integral, Eq Significand
Significand
Eq Significand
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand -> Significand)
-> (Significand -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> Significand
-> (Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Bool)
-> (Significand -> Maybe Int)
-> (Significand -> Int)
-> (Significand -> Bool)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int -> Significand)
-> (Significand -> Int)
-> Bits Significand
Int -> Significand
Significand -> Bool
Significand -> Int
Significand -> Maybe Int
Significand -> Significand
Significand -> Int -> Bool
Significand -> Int -> Significand
Significand -> Significand -> Significand
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
popCount :: Significand -> Int
$cpopCount :: Significand -> Int
rotateR :: Significand -> Int -> Significand
$crotateR :: Significand -> Int -> Significand
rotateL :: Significand -> Int -> Significand
$crotateL :: Significand -> Int -> Significand
unsafeShiftR :: Significand -> Int -> Significand
$cunsafeShiftR :: Significand -> Int -> Significand
shiftR :: Significand -> Int -> Significand
$cshiftR :: Significand -> Int -> Significand
unsafeShiftL :: Significand -> Int -> Significand
$cunsafeShiftL :: Significand -> Int -> Significand
shiftL :: Significand -> Int -> Significand
$cshiftL :: Significand -> Int -> Significand
isSigned :: Significand -> Bool
$cisSigned :: Significand -> Bool
bitSize :: Significand -> Int
$cbitSize :: Significand -> Int
bitSizeMaybe :: Significand -> Maybe Int
$cbitSizeMaybe :: Significand -> Maybe Int
testBit :: Significand -> Int -> Bool
$ctestBit :: Significand -> Int -> Bool
complementBit :: Significand -> Int -> Significand
$ccomplementBit :: Significand -> Int -> Significand
clearBit :: Significand -> Int -> Significand
$cclearBit :: Significand -> Int -> Significand
setBit :: Significand -> Int -> Significand
$csetBit :: Significand -> Int -> Significand
bit :: Int -> Significand
$cbit :: Int -> Significand
zeroBits :: Significand
$czeroBits :: Significand
rotate :: Significand -> Int -> Significand
$crotate :: Significand -> Int -> Significand
shift :: Significand -> Int -> Significand
$cshift :: Significand -> Int -> Significand
complement :: Significand -> Significand
$ccomplement :: Significand -> Significand
xor :: Significand -> Significand -> Significand
$cxor :: Significand -> Significand -> Significand
.|. :: Significand -> Significand -> Significand
$c.|. :: Significand -> Significand -> Significand
.&. :: Significand -> Significand -> Significand
$c.&. :: Significand -> Significand -> Significand
$cp1Bits :: Eq Significand
Bits)

newtype BitCount = BitCount Int
    deriving (Int -> BitCount -> ShowS
[BitCount] -> ShowS
BitCount -> String
(Int -> BitCount -> ShowS)
-> (BitCount -> String) -> ([BitCount] -> ShowS) -> Show BitCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitCount] -> ShowS
$cshowList :: [BitCount] -> ShowS
show :: BitCount -> String
$cshow :: BitCount -> String
showsPrec :: Int -> BitCount -> ShowS
$cshowsPrec :: Int -> BitCount -> ShowS
Show, BitCount -> BitCount -> Bool
(BitCount -> BitCount -> Bool)
-> (BitCount -> BitCount -> Bool) -> Eq BitCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitCount -> BitCount -> Bool
$c/= :: BitCount -> BitCount -> Bool
== :: BitCount -> BitCount -> Bool
$c== :: BitCount -> BitCount -> Bool
Eq, Integer -> BitCount
BitCount -> BitCount
BitCount -> BitCount -> BitCount
(BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount)
-> (BitCount -> BitCount)
-> (BitCount -> BitCount)
-> (Integer -> BitCount)
-> Num BitCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BitCount
$cfromInteger :: Integer -> BitCount
signum :: BitCount -> BitCount
$csignum :: BitCount -> BitCount
abs :: BitCount -> BitCount
$cabs :: BitCount -> BitCount
negate :: BitCount -> BitCount
$cnegate :: BitCount -> BitCount
* :: BitCount -> BitCount -> BitCount
$c* :: BitCount -> BitCount -> BitCount
- :: BitCount -> BitCount -> BitCount
$c- :: BitCount -> BitCount -> BitCount
+ :: BitCount -> BitCount -> BitCount
$c+ :: BitCount -> BitCount -> BitCount
Num, Eq BitCount
Eq BitCount
-> (BitCount -> BitCount -> Ordering)
-> (BitCount -> BitCount -> Bool)
-> (BitCount -> BitCount -> Bool)
-> (BitCount -> BitCount -> Bool)
-> (BitCount -> BitCount -> Bool)
-> (BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount -> BitCount)
-> Ord BitCount
BitCount -> BitCount -> Bool
BitCount -> BitCount -> Ordering
BitCount -> BitCount -> BitCount
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
min :: BitCount -> BitCount -> BitCount
$cmin :: BitCount -> BitCount -> BitCount
max :: BitCount -> BitCount -> BitCount
$cmax :: BitCount -> BitCount -> BitCount
>= :: BitCount -> BitCount -> Bool
$c>= :: BitCount -> BitCount -> Bool
> :: BitCount -> BitCount -> Bool
$c> :: BitCount -> BitCount -> Bool
<= :: BitCount -> BitCount -> Bool
$c<= :: BitCount -> BitCount -> Bool
< :: BitCount -> BitCount -> Bool
$c< :: BitCount -> BitCount -> Bool
compare :: BitCount -> BitCount -> Ordering
$ccompare :: BitCount -> BitCount -> Ordering
$cp1Ord :: Eq BitCount
Ord, Num BitCount
Ord BitCount
Num BitCount
-> Ord BitCount -> (BitCount -> Rational) -> Real BitCount
BitCount -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: BitCount -> Rational
$ctoRational :: BitCount -> Rational
$cp2Real :: Ord BitCount
$cp1Real :: Num BitCount
Real, Int -> BitCount
BitCount -> Int
BitCount -> [BitCount]
BitCount -> BitCount
BitCount -> BitCount -> [BitCount]
BitCount -> BitCount -> BitCount -> [BitCount]
(BitCount -> BitCount)
-> (BitCount -> BitCount)
-> (Int -> BitCount)
-> (BitCount -> Int)
-> (BitCount -> [BitCount])
-> (BitCount -> BitCount -> [BitCount])
-> (BitCount -> BitCount -> [BitCount])
-> (BitCount -> BitCount -> BitCount -> [BitCount])
-> Enum BitCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BitCount -> BitCount -> BitCount -> [BitCount]
$cenumFromThenTo :: BitCount -> BitCount -> BitCount -> [BitCount]
enumFromTo :: BitCount -> BitCount -> [BitCount]
$cenumFromTo :: BitCount -> BitCount -> [BitCount]
enumFromThen :: BitCount -> BitCount -> [BitCount]
$cenumFromThen :: BitCount -> BitCount -> [BitCount]
enumFrom :: BitCount -> [BitCount]
$cenumFrom :: BitCount -> [BitCount]
fromEnum :: BitCount -> Int
$cfromEnum :: BitCount -> Int
toEnum :: Int -> BitCount
$ctoEnum :: Int -> BitCount
pred :: BitCount -> BitCount
$cpred :: BitCount -> BitCount
succ :: BitCount -> BitCount
$csucc :: BitCount -> BitCount
Enum, Enum BitCount
Real BitCount
Real BitCount
-> Enum BitCount
-> (BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount -> BitCount)
-> (BitCount -> BitCount -> (BitCount, BitCount))
-> (BitCount -> BitCount -> (BitCount, BitCount))
-> (BitCount -> Integer)
-> Integral BitCount
BitCount -> Integer
BitCount -> BitCount -> (BitCount, BitCount)
BitCount -> BitCount -> BitCount
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: BitCount -> Integer
$ctoInteger :: BitCount -> Integer
divMod :: BitCount -> BitCount -> (BitCount, BitCount)
$cdivMod :: BitCount -> BitCount -> (BitCount, BitCount)
quotRem :: BitCount -> BitCount -> (BitCount, BitCount)
$cquotRem :: BitCount -> BitCount -> (BitCount, BitCount)
mod :: BitCount -> BitCount -> BitCount
$cmod :: BitCount -> BitCount -> BitCount
div :: BitCount -> BitCount -> BitCount
$cdiv :: BitCount -> BitCount -> BitCount
rem :: BitCount -> BitCount -> BitCount
$crem :: BitCount -> BitCount -> BitCount
quot :: BitCount -> BitCount -> BitCount
$cquot :: BitCount -> BitCount -> BitCount
$cp2Integral :: Enum BitCount
$cp1Integral :: Real BitCount
Integral)

newtype ByteCount = ByteCount Int
    deriving (Int -> ByteCount -> ShowS
[ByteCount] -> ShowS
ByteCount -> String
(Int -> ByteCount -> ShowS)
-> (ByteCount -> String)
-> ([ByteCount] -> ShowS)
-> Show ByteCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteCount] -> ShowS
$cshowList :: [ByteCount] -> ShowS
show :: ByteCount -> String
$cshow :: ByteCount -> String
showsPrec :: Int -> ByteCount -> ShowS
$cshowsPrec :: Int -> ByteCount -> ShowS
Show, ByteCount -> ByteCount -> Bool
(ByteCount -> ByteCount -> Bool)
-> (ByteCount -> ByteCount -> Bool) -> Eq ByteCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteCount -> ByteCount -> Bool
$c/= :: ByteCount -> ByteCount -> Bool
== :: ByteCount -> ByteCount -> Bool
$c== :: ByteCount -> ByteCount -> Bool
Eq, Integer -> ByteCount
ByteCount -> ByteCount
ByteCount -> ByteCount -> ByteCount
(ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount)
-> (ByteCount -> ByteCount)
-> (ByteCount -> ByteCount)
-> (Integer -> ByteCount)
-> Num ByteCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ByteCount
$cfromInteger :: Integer -> ByteCount
signum :: ByteCount -> ByteCount
$csignum :: ByteCount -> ByteCount
abs :: ByteCount -> ByteCount
$cabs :: ByteCount -> ByteCount
negate :: ByteCount -> ByteCount
$cnegate :: ByteCount -> ByteCount
* :: ByteCount -> ByteCount -> ByteCount
$c* :: ByteCount -> ByteCount -> ByteCount
- :: ByteCount -> ByteCount -> ByteCount
$c- :: ByteCount -> ByteCount -> ByteCount
+ :: ByteCount -> ByteCount -> ByteCount
$c+ :: ByteCount -> ByteCount -> ByteCount
Num, Eq ByteCount
Eq ByteCount
-> (ByteCount -> ByteCount -> Ordering)
-> (ByteCount -> ByteCount -> Bool)
-> (ByteCount -> ByteCount -> Bool)
-> (ByteCount -> ByteCount -> Bool)
-> (ByteCount -> ByteCount -> Bool)
-> (ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount -> ByteCount)
-> Ord ByteCount
ByteCount -> ByteCount -> Bool
ByteCount -> ByteCount -> Ordering
ByteCount -> ByteCount -> ByteCount
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
min :: ByteCount -> ByteCount -> ByteCount
$cmin :: ByteCount -> ByteCount -> ByteCount
max :: ByteCount -> ByteCount -> ByteCount
$cmax :: ByteCount -> ByteCount -> ByteCount
>= :: ByteCount -> ByteCount -> Bool
$c>= :: ByteCount -> ByteCount -> Bool
> :: ByteCount -> ByteCount -> Bool
$c> :: ByteCount -> ByteCount -> Bool
<= :: ByteCount -> ByteCount -> Bool
$c<= :: ByteCount -> ByteCount -> Bool
< :: ByteCount -> ByteCount -> Bool
$c< :: ByteCount -> ByteCount -> Bool
compare :: ByteCount -> ByteCount -> Ordering
$ccompare :: ByteCount -> ByteCount -> Ordering
$cp1Ord :: Eq ByteCount
Ord, Num ByteCount
Ord ByteCount
Num ByteCount
-> Ord ByteCount -> (ByteCount -> Rational) -> Real ByteCount
ByteCount -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ByteCount -> Rational
$ctoRational :: ByteCount -> Rational
$cp2Real :: Ord ByteCount
$cp1Real :: Num ByteCount
Real, Int -> ByteCount
ByteCount -> Int
ByteCount -> [ByteCount]
ByteCount -> ByteCount
ByteCount -> ByteCount -> [ByteCount]
ByteCount -> ByteCount -> ByteCount -> [ByteCount]
(ByteCount -> ByteCount)
-> (ByteCount -> ByteCount)
-> (Int -> ByteCount)
-> (ByteCount -> Int)
-> (ByteCount -> [ByteCount])
-> (ByteCount -> ByteCount -> [ByteCount])
-> (ByteCount -> ByteCount -> [ByteCount])
-> (ByteCount -> ByteCount -> ByteCount -> [ByteCount])
-> Enum ByteCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ByteCount -> ByteCount -> ByteCount -> [ByteCount]
$cenumFromThenTo :: ByteCount -> ByteCount -> ByteCount -> [ByteCount]
enumFromTo :: ByteCount -> ByteCount -> [ByteCount]
$cenumFromTo :: ByteCount -> ByteCount -> [ByteCount]
enumFromThen :: ByteCount -> ByteCount -> [ByteCount]
$cenumFromThen :: ByteCount -> ByteCount -> [ByteCount]
enumFrom :: ByteCount -> [ByteCount]
$cenumFrom :: ByteCount -> [ByteCount]
fromEnum :: ByteCount -> Int
$cfromEnum :: ByteCount -> Int
toEnum :: Int -> ByteCount
$ctoEnum :: Int -> ByteCount
pred :: ByteCount -> ByteCount
$cpred :: ByteCount -> ByteCount
succ :: ByteCount -> ByteCount
$csucc :: ByteCount -> ByteCount
Enum, Enum ByteCount
Real ByteCount
Real ByteCount
-> Enum ByteCount
-> (ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount -> ByteCount)
-> (ByteCount -> ByteCount -> (ByteCount, ByteCount))
-> (ByteCount -> ByteCount -> (ByteCount, ByteCount))
-> (ByteCount -> Integer)
-> Integral ByteCount
ByteCount -> Integer
ByteCount -> ByteCount -> (ByteCount, ByteCount)
ByteCount -> ByteCount -> ByteCount
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ByteCount -> Integer
$ctoInteger :: ByteCount -> Integer
divMod :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
$cdivMod :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
quotRem :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
$cquotRem :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
mod :: ByteCount -> ByteCount -> ByteCount
$cmod :: ByteCount -> ByteCount -> ByteCount
div :: ByteCount -> ByteCount -> ByteCount
$cdiv :: ByteCount -> ByteCount -> ByteCount
rem :: ByteCount -> ByteCount -> ByteCount
$crem :: ByteCount -> ByteCount -> ByteCount
quot :: ByteCount -> ByteCount -> ByteCount
$cquot :: ByteCount -> ByteCount -> ByteCount
$cp2Integral :: Enum ByteCount
$cp1Integral :: Real ByteCount
Integral)

bitCount :: ByteCount -> BitCount
bitCount :: ByteCount -> BitCount
bitCount (ByteCount Int
x) = Int -> BitCount
BitCount (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)

bitsInWord8 :: [Word8] -> BitCount
bitsInWord8 :: [Word8] -> BitCount
bitsInWord8 = ByteCount -> BitCount
bitCount (ByteCount -> BitCount)
-> ([Word8] -> ByteCount) -> [Word8] -> BitCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteCount
ByteCount (Int -> ByteCount) -> ([Word8] -> Int) -> [Word8] -> ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

bitShiftL :: (Bits a) => a -> BitCount -> a
bitShiftL :: a -> BitCount -> a
bitShiftL a
x (BitCount Int
n) = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
x Int
n

bitShiftR :: (Bits a) => a -> BitCount -> a
bitShiftR :: a -> BitCount -> a
bitShiftR a
x (BitCount Int
n) = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
x Int
n
\end{code}

\section{Utility}

Considering a byte list as a sequence of bits, slice it from start
inclusive to end exclusive, and return the resulting bit sequence as an
integer.

\begin{code}
bitSlice :: [Word8] -> BitCount -> BitCount -> Integer
bitSlice :: [Word8] -> BitCount -> BitCount -> Integer
bitSlice [Word8]
bs = Integer -> BitCount -> BitCount -> BitCount -> Integer
sliceInt ((Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Word8 -> Integer
forall a a. (Bits a, Integral a, Num a) => a -> a -> a
step Integer
0 [Word8]
bs) BitCount
bitCount' where
    step :: a -> a -> a
step a
acc a
w     = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
acc Int
8 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w
    bitCount' :: BitCount
bitCount'      = [Word8] -> BitCount
bitsInWord8 [Word8]
bs
\end{code}

Slice a single integer by start and end bit location

\begin{code}
sliceInt :: Integer -> BitCount -> BitCount -> BitCount -> Integer
sliceInt :: Integer -> BitCount -> BitCount -> BitCount -> Integer
sliceInt Integer
x BitCount
xBitCount BitCount
s BitCount
e = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sliced where
    sliced :: Integer
sliced = (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
startMask) Integer -> BitCount -> Integer
forall a. Bits a => a -> BitCount -> a
`bitShiftR` (BitCount
xBitCount BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
e)
    startMask :: Integer
startMask = BitCount -> Integer
forall b a. (Integral b, Integral a) => b -> a
n1Bits (BitCount
xBitCount BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
- BitCount
s)
    n1Bits :: b -> a
n1Bits b
n  = (Integer
2 Integer -> b -> a
forall a b c. (Integral a, Integral b, Integral c) => a -> b -> c
`pow` b
n) a -> a -> a
forall a. Num a => a -> a -> a
- a
1
\end{code}

Integral version of {\tt (**)}

\begin{code}
pow :: (Integral a, Integral b, Integral c) => a -> b -> c
pow :: a -> b -> c
pow a
b b
e = Double -> c
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> c) -> Double -> c
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b Double -> Double -> Double
forall a. Floating a => a -> a -> a
** b -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
e
\end{code}

Detect whether a float is {\tt $-$NaN}

\begin{code}
isNegativeNaN :: RealFloat a => a -> Bool
isNegativeNaN :: a -> Bool
isNegativeNaN a
x = a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
&& (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0)
\end{code}