summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorKrasimir Angelov <kr.angelov@gmail.com>2017-09-04 09:55:17 +0200
committerKrasimir Angelov <kr.angelov@gmail.com>2017-09-04 09:55:17 +0200
commit4fe9f88128515a75f790c353190f340c4179d464 (patch)
tree2abd8102f4d2196a00af3018acd2a882ad035696 /src
parentbbdbf2bc5d34d75cef032b395e4a5cc35a89066d (diff)
move the custom Binary package back to src/runtime/haskell
Diffstat (limited to 'src')
-rw-r--r--src/runtime/haskell/Data/Binary.hs (renamed from src/binary/Data/Binary.hs)0
-rw-r--r--src/runtime/haskell/Data/Binary/Builder.hs (renamed from src/binary/Data/Binary/Builder.hs)0
-rw-r--r--src/runtime/haskell/Data/Binary/Get.hs (renamed from src/binary/Data/Binary/Get.hs)0
-rw-r--r--src/runtime/haskell/Data/Binary/IEEE754.lhs (renamed from src/binary/Data/Binary/IEEE754.lhs)200
-rw-r--r--src/runtime/haskell/Data/Binary/Put.hs (renamed from src/binary/Data/Binary/Put.hs)0
5 files changed, 100 insertions, 100 deletions
diff --git a/src/binary/Data/Binary.hs b/src/runtime/haskell/Data/Binary.hs
index 4b3f06a80..4b3f06a80 100644
--- a/src/binary/Data/Binary.hs
+++ b/src/runtime/haskell/Data/Binary.hs
diff --git a/src/binary/Data/Binary/Builder.hs b/src/runtime/haskell/Data/Binary/Builder.hs
index 03531daa7..03531daa7 100644
--- a/src/binary/Data/Binary/Builder.hs
+++ b/src/runtime/haskell/Data/Binary/Builder.hs
diff --git a/src/binary/Data/Binary/Get.hs b/src/runtime/haskell/Data/Binary/Get.hs
index 6e98434f5..6e98434f5 100644
--- a/src/binary/Data/Binary/Get.hs
+++ b/src/runtime/haskell/Data/Binary/Get.hs
diff --git a/src/binary/Data/Binary/IEEE754.lhs b/src/runtime/haskell/Data/Binary/IEEE754.lhs
index 96cbefc5a..26395a054 100644
--- a/src/binary/Data/Binary/IEEE754.lhs
+++ b/src/runtime/haskell/Data/Binary/IEEE754.lhs
@@ -17,14 +17,14 @@
\begin{code}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Binary.IEEE754 (
- -- * Parsing
- getFloat16be, getFloat16le
- , getFloat32be, getFloat32le
- , getFloat64be, getFloat64le
-
- -- * Serializing
- , putFloat32be, putFloat32le
- , putFloat64be, putFloat64le
+ -- * Parsing
+ getFloat16be, getFloat16le
+ , getFloat32be, getFloat32le
+ , getFloat64be, getFloat64le
+
+ -- * Serializing
+ , putFloat32be, putFloat32le
+ , putFloat64be, putFloat64le
) where
import Data.Bits ((.&.), (.|.), shiftL, shiftR, Bits)
@@ -80,19 +80,19 @@ original float, and have not been unbiased or otherwise modified.
\begin{code}
splitBytes :: [Word8] -> RawFloat
splitBytes bs = RawFloat width sign exp' sig expWidth sigWidth where
- width = ByteCount (length bs)
- nBits = bitsInWord8 bs
- sign = if head bs .&. 0x80 == 0x80
- then Negative
- else Positive
-
- expStart = 1
- expWidth = exponentWidth nBits
- expEnd = expStart + expWidth
- exp' = Exponent . fromIntegral $ bitSlice bs expStart expEnd
-
- sigWidth = nBits - expEnd
- sig = Significand $ bitSlice bs expEnd nBits
+ width = ByteCount (length bs)
+ nBits = bitsInWord8 bs
+ sign = if head bs .&. 0x80 == 0x80
+ then Negative
+ else Positive
+
+ expStart = 1
+ expWidth = exponentWidth nBits
+ expEnd = expStart + expWidth
+ exp' = Exponent . fromIntegral $ bitSlice bs expStart expEnd
+
+ sigWidth = nBits - expEnd
+ sig = Significand $ bitSlice bs expEnd nBits
\end{code}
\subsubsection{Encodings and special values}
@@ -123,14 +123,14 @@ are constructed using the {\tt Read} instances for {\tt Double} and
\begin{code}
merge :: (Read a, RealFloat a) => RawFloat -> a
merge f@(RawFloat _ _ e sig eWidth _)
- | e == 0 = if sig == 0
- then 0.0
- else denormalised f
- | e == eMax - 1 = if sig == 0
- then read "Infinity"
- else read "NaN"
- | otherwise = normalised f
- where eMax = 2 `pow` eWidth
+ | e == 0 = if sig == 0
+ then 0.0
+ else denormalised f
+ | e == eMax - 1 = if sig == 0
+ then read "Infinity"
+ else read "NaN"
+ | otherwise = normalised f
+ where eMax = 2 `pow` eWidth
\end{code}
If a value is normalised, its significand has an implied {\tt 1} bit
@@ -140,13 +140,13 @@ this value before being passed to {\tt encodeField}.
\begin{code}
normalised :: RealFloat a => RawFloat -> a
normalised f = encodeFloat fraction exp' where
- Significand sig = rawSignificand f
- Exponent exp' = unbiased - sigWidth
-
- fraction = sig + (1 `bitShiftL` rawSignificandWidth f)
-
- sigWidth = fromIntegral $ rawSignificandWidth f
- unbiased = unbias (rawExponent f) (rawExponentWidth f)
+ Significand sig = rawSignificand f
+ Exponent exp' = unbiased - sigWidth
+
+ fraction = sig + (1 `bitShiftL` rawSignificandWidth f)
+
+ sigWidth = fromIntegral $ rawSignificandWidth f
+ unbiased = unbias (rawExponent f) (rawExponentWidth f)
\end{code}
For denormalised values, the implied {\tt 1} bit is the least-significant
@@ -155,11 +155,11 @@ bit of the exponent.
\begin{code}
denormalised :: RealFloat a => RawFloat -> a
denormalised f = encodeFloat sig exp' where
- Significand sig = rawSignificand f
- Exponent exp' = unbiased - sigWidth + 1
-
- sigWidth = fromIntegral $ rawSignificandWidth f
- unbiased = unbias (rawExponent f) (rawExponentWidth f)
+ Significand sig = rawSignificand f
+ Exponent exp' = unbiased - sigWidth + 1
+
+ sigWidth = fromIntegral $ rawSignificandWidth f
+ unbiased = unbias (rawExponent f) (rawExponentWidth f)
\end{code}
By composing {\tt splitBytes} and {\tt merge}, the absolute value of the
@@ -170,11 +170,11 @@ must be signed appropriately.
getFloat :: (Read a, RealFloat a) => ByteCount
-> ([Word8] -> RawFloat) -> Get a
getFloat (ByteCount width) parser = do
- raw <- fmap (parser . B.unpack) $ getByteString width
- let absFloat = merge raw
- return $ case rawSign raw of
- Positive -> absFloat
- Negative -> -absFloat
+ raw <- fmap (parser . B.unpack) $ getByteString width
+ let absFloat = merge raw
+ return $ case rawSign raw of
+ Positive -> absFloat
+ Negative -> -absFloat
\end{code}
\section{Serialising}
@@ -211,24 +211,24 @@ stored in the {\tt RawFloat}.
\begin{code}
splitFloat :: RealFloat a => ByteCount -> a -> RawFloat
splitFloat width x = raw where
- raw = RawFloat width sign clampedExp clampedSig expWidth sigWidth
- sign = if isNegativeNaN x || isNegativeZero x || x < 0
- then Negative
- else Positive
- clampedExp = clamp expWidth exp'
- clampedSig = clamp sigWidth sig
- (exp', sig) = case (dFraction, dExponent, biasedExp) of
- (0, 0, _) -> (0, 0)
- (_, _, 0) -> (0, Significand $ truncatedSig + 1)
- _ -> (biasedExp, Significand truncatedSig)
- expWidth = exponentWidth $ bitCount width
- sigWidth = bitCount width - expWidth - 1 -- 1 for sign bit
-
- (dFraction, dExponent) = decodeFloat x
-
- rawExp = Exponent $ dExponent + fromIntegral sigWidth
- biasedExp = bias rawExp expWidth
- truncatedSig = abs dFraction - (1 `bitShiftL` sigWidth)
+ raw = RawFloat width sign clampedExp clampedSig expWidth sigWidth
+ sign = if isNegativeNaN x || isNegativeZero x || x < 0
+ then Negative
+ else Positive
+ clampedExp = clamp expWidth exp'
+ clampedSig = clamp sigWidth sig
+ (exp', sig) = case (dFraction, dExponent, biasedExp) of
+ (0, 0, _) -> (0, 0)
+ (_, _, 0) -> (0, Significand $ truncatedSig + 1)
+ _ -> (biasedExp, Significand truncatedSig)
+ expWidth = exponentWidth $ bitCount width
+ sigWidth = bitCount width - expWidth - 1 -- 1 for sign bit
+
+ (dFraction, dExponent) = decodeFloat x
+
+ rawExp = Exponent $ dExponent + fromIntegral sigWidth
+ biasedExp = bias rawExp expWidth
+ truncatedSig = abs dFraction - (1 `bitShiftL` sigWidth)
\end{code}
Then, the {\tt RawFloat} is converted to a list of bytes by mashing all
@@ -238,14 +238,14 @@ in 8-bit blocks.
\begin{code}
rawToBytes :: RawFloat -> [Word8]
rawToBytes raw = integerToBytes mashed width where
- RawFloat width sign exp' sig expWidth sigWidth = raw
- sign' :: Word8
- sign' = case sign of
- Positive -> 0
- Negative -> 1
- mashed = mashBits sig sigWidth .
- mashBits exp' expWidth .
- mashBits sign' 1 $ 0
+ RawFloat width sign exp' sig expWidth sigWidth = raw
+ sign' :: Word8
+ sign' = case sign of
+ Positive -> 0
+ Negative -> 1
+ mashed = mashBits sig sigWidth .
+ mashBits exp' expWidth .
+ mashBits sign' 1 $ 0
\end{code}
{\tt clamp}, given a maximum bit count and a value, will strip any 1-bits
@@ -254,9 +254,9 @@ in positions above the count.
\begin{code}
clamp :: (Num a, Bits a) => BitCount -> a -> a
clamp = (.&.) . mask where
- mask 1 = 1
- mask n | n > 1 = (mask (n - 1) `shiftL` 1) + 1
- mask _ = undefined
+ mask 1 = 1
+ mask n | n > 1 = (mask (n - 1) `shiftL` 1) + 1
+ mask _ = undefined
\end{code}
For merging the fields, just shift the starting integer over a bit and
@@ -276,8 +276,8 @@ Each increment is converted to a byte and added to the final list.
integerToBytes :: Integer -> ByteCount -> [Word8]
integerToBytes _ 0 = []
integerToBytes x n = bytes where
- bytes = integerToBytes (x `shiftR` 8) (n - 1) ++ [step]
- step = fromIntegral x .&. 0xFF
+ bytes = integerToBytes (x `shiftR` 8) (n - 1) ++ [step]
+ step = fromIntegral x .&. 0xFF
\end{code}
Finally, the raw parsing is wrapped up in {\tt Put}. The second parameter
@@ -287,7 +287,7 @@ serialisation.
\begin{code}
putFloat :: (RealFloat a) => ByteCount -> ([Word8] -> [Word8]) -> a -> Put
putFloat width f x = putByteString $ B.pack bytes where
- bytes = f . rawToBytes . splitFloat width $ x
+ bytes = f . rawToBytes . splitFloat width $ x
\end{code}
\section{Raw float components}
@@ -299,14 +299,14 @@ shouldn't have it's implied MSB (if applicable).
\begin{code}
data RawFloat = RawFloat
- { rawWidth :: ByteCount
- , rawSign :: Sign
- , rawExponent :: Exponent
- , rawSignificand :: Significand
- , rawExponentWidth :: BitCount
- , rawSignificandWidth :: BitCount
- }
- deriving (Show)
+ { rawWidth :: ByteCount
+ , rawSign :: Sign
+ , rawExponent :: Exponent
+ , rawSignificand :: Significand
+ , rawExponentWidth :: BitCount
+ , rawSignificandWidth :: BitCount
+ }
+ deriving (Show)
\end{code}
\section{Exponents}
@@ -317,10 +317,10 @@ size of the full structure.
\begin{code}
exponentWidth :: BitCount -> BitCount
exponentWidth k
- | k == 16 = 5
- | k == 32 = 8
- | k `mod` 32 == 0 = ceiling (4 * logBase 2 (fromIntegral k)) - 13
- | otherwise = error "Invalid length of floating-point value"
+ | k == 16 = 5
+ | k == 32 = 8
+ | k `mod` 32 == 0 = ceiling (4 * logBase 2 (fromIntegral k)) - 13
+ | otherwise = error "Invalid length of floating-point value"
\end{code}
\begin{code}
@@ -337,19 +337,19 @@ unbias e eWidth = e + 1 - (2 `pow` (eWidth - 1))
\begin{code}
data Sign = Positive | Negative
- deriving (Show)
+ deriving (Show)
newtype Exponent = Exponent Int
- deriving (Show, Eq, Num, Ord, Real, Enum, Integral, Bits)
+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral, Bits)
newtype Significand = Significand Integer
- deriving (Show, Eq, Num, Ord, Real, Enum, Integral, Bits)
+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral, Bits)
newtype BitCount = BitCount Int
- deriving (Show, Eq, Num, Ord, Real, Enum, Integral)
+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral)
newtype ByteCount = ByteCount Int
- deriving (Show, Eq, Num, Ord, Real, Enum, Integral)
+ deriving (Show, Eq, Num, Ord, Real, Enum, Integral)
bitCount :: ByteCount -> BitCount
bitCount (ByteCount x) = BitCount (x * 8)
@@ -373,8 +373,8 @@ integer.
\begin{code}
bitSlice :: [Word8] -> BitCount -> BitCount -> Integer
bitSlice bs = sliceInt (foldl' step 0 bs) bitCount' where
- step acc w = shiftL acc 8 + fromIntegral w
- bitCount' = bitsInWord8 bs
+ step acc w = shiftL acc 8 + fromIntegral w
+ bitCount' = bitsInWord8 bs
\end{code}
Slice a single integer by start and end bit location
@@ -382,9 +382,9 @@ Slice a single integer by start and end bit location
\begin{code}
sliceInt :: Integer -> BitCount -> BitCount -> BitCount -> Integer
sliceInt x xBitCount s e = fromIntegral sliced where
- sliced = (x .&. startMask) `bitShiftR` (xBitCount - e)
- startMask = n1Bits (xBitCount - s)
- n1Bits n = (2 `pow` n) - 1
+ sliced = (x .&. startMask) `bitShiftR` (xBitCount - e)
+ startMask = n1Bits (xBitCount - s)
+ n1Bits n = (2 `pow` n) - 1
\end{code}
Integral version of {\tt (**)}
diff --git a/src/binary/Data/Binary/Put.hs b/src/runtime/haskell/Data/Binary/Put.hs
index 189cf806f..189cf806f 100644
--- a/src/binary/Data/Binary/Put.hs
+++ b/src/runtime/haskell/Data/Binary/Put.hs