move the custom Binary package back to src/runtime/haskell

gf.cabal

@@ -89,7 +89,6 @@ Library
   hs-source-dirs: src/runtime/haskell
 
   if flag(custom-binary)
-    hs-source-dirs: src/binary
     other-modules:
       -- not really part of GF but I have changed the original binary library
       -- and we have to keep the copy for now.

src/runtime/haskell/Data/Binary/IEEE754.lhs

@@ -17,14 +17,14 @@
 \begin{code}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Data.Binary.IEEE754 (
-	-- * Parsing
+    -- * Parsing
-	  getFloat16be, getFloat16le
+      getFloat16be, getFloat16le
-	, getFloat32be, getFloat32le
+    , getFloat32be, getFloat32le
-	, getFloat64be, getFloat64le
+    , getFloat64be, getFloat64le
-	
+
-	-- * Serializing
+    -- * Serializing
-	, putFloat32be, putFloat32le
+    , putFloat32be, putFloat32le
-	, putFloat64be, putFloat64le
+    , 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)
+    width = ByteCount (length bs)
-	nBits = bitsInWord8 bs
+    nBits = bitsInWord8 bs
-	sign = if head bs .&. 0x80 == 0x80
+    sign = if head bs .&. 0x80 == 0x80
-		then Negative
+             then Negative
-		else Positive
+             else Positive
-	
+
-	expStart = 1
+    expStart = 1
-	expWidth = exponentWidth nBits
+    expWidth = exponentWidth nBits
-	expEnd = expStart + expWidth
+    expEnd = expStart + expWidth
-	exp' = Exponent . fromIntegral $ bitSlice bs expStart expEnd
+    exp' = Exponent . fromIntegral $ bitSlice bs expStart expEnd
-	
+
-	sigWidth = nBits - expEnd
+    sigWidth = nBits - expEnd
-	sig  = Significand $ bitSlice bs expEnd nBits
+    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
+    | e == 0 = if sig == 0
-		then 0.0
+                 then 0.0
-		else denormalised f
+                 else denormalised f
-	| e == eMax - 1 = if sig == 0
+    | e == eMax - 1 = if sig == 0
-		then read "Infinity"
+                        then read "Infinity"
-		else read "NaN"
+                        else read "NaN"
-	| otherwise = normalised f
+    | otherwise = normalised f
-	where eMax = 2 `pow` eWidth
+    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
+    Significand sig = rawSignificand f
-	Exponent exp' = unbiased - sigWidth
+    Exponent exp' = unbiased - sigWidth
-	
+
-	fraction = sig + (1 `bitShiftL` rawSignificandWidth f)
+    fraction = sig + (1 `bitShiftL` rawSignificandWidth f)
-	
+
-	sigWidth = fromIntegral $ rawSignificandWidth f
+    sigWidth = fromIntegral $ rawSignificandWidth f
-	unbiased = unbias (rawExponent f) (rawExponentWidth 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
+    Significand sig = rawSignificand f
-	Exponent exp' = unbiased - sigWidth + 1
+    Exponent exp' = unbiased - sigWidth + 1
-	
+
-	sigWidth = fromIntegral $ rawSignificandWidth f
+    sigWidth = fromIntegral $ rawSignificandWidth f
-	unbiased = unbias (rawExponent f) (rawExponentWidth 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
+    raw <- fmap (parser . B.unpack) $ getByteString width
-	let absFloat = merge raw
+    let absFloat = merge raw
-	return $ case rawSign raw of
+    return $ case rawSign raw of
-		Positive ->  absFloat
+               Positive ->  absFloat
-		Negative -> -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
+    raw = RawFloat width sign clampedExp clampedSig expWidth sigWidth
-	sign = if isNegativeNaN x || isNegativeZero x || x < 0
+    sign = if isNegativeNaN x || isNegativeZero x || x < 0
-		then Negative
+             then Negative
-		else Positive
+             else Positive
-	clampedExp = clamp expWidth exp'
+    clampedExp = clamp expWidth exp'
-	clampedSig = clamp sigWidth sig
+    clampedSig = clamp sigWidth sig
-	(exp', sig) = case (dFraction, dExponent, biasedExp) of
+    (exp', sig) = case (dFraction, dExponent, biasedExp) of
-		(0, 0, _) -> (0, 0)
+                    (0, 0, _) -> (0, 0)
-		(_, _, 0) -> (0, Significand $ truncatedSig + 1)
+                    (_, _, 0) -> (0, Significand $ truncatedSig + 1)
-		_         -> (biasedExp, Significand truncatedSig)
+                    _         -> (biasedExp, Significand truncatedSig)
-	expWidth = exponentWidth $ bitCount width
+    expWidth = exponentWidth $ bitCount width
-	sigWidth = bitCount width - expWidth - 1 -- 1 for sign bit
+    sigWidth = bitCount width - expWidth - 1 -- 1 for sign bit
-	
+
-	(dFraction, dExponent) = decodeFloat x
+    (dFraction, dExponent) = decodeFloat x
-	
+
-	rawExp = Exponent $ dExponent + fromIntegral sigWidth
+    rawExp = Exponent $ dExponent + fromIntegral sigWidth
-	biasedExp = bias rawExp expWidth
+    biasedExp = bias rawExp expWidth
-	truncatedSig = abs dFraction - (1 `bitShiftL` sigWidth)
+    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
+    RawFloat width sign exp' sig expWidth sigWidth = raw
-	sign' :: Word8
+    sign' :: Word8
-	sign' = case sign of
+    sign' = case sign of
-		Positive -> 0
+              Positive -> 0
-		Negative -> 1
+              Negative -> 1
-	mashed = mashBits sig sigWidth .
+    mashed = mashBits sig sigWidth .
-	         mashBits exp' expWidth .
+             mashBits exp' expWidth .
-	         mashBits sign' 1 $ 0
+             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 1 = 1
-	mask n | n > 1 = (mask (n - 1) `shiftL` 1) + 1
+    mask n | n > 1 = (mask (n - 1) `shiftL` 1) + 1
-	mask _ = undefined
+    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]
+    bytes = integerToBytes (x `shiftR` 8) (n - 1) ++ [step]
-	step = fromIntegral x .&. 0xFF
+    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
+    { rawWidth            :: ByteCount
-	, rawSign             :: Sign
+    , rawSign             :: Sign
-	, rawExponent         :: Exponent
+    , rawExponent         :: Exponent
-	, rawSignificand      :: Significand
+    , rawSignificand      :: Significand
-	, rawExponentWidth    :: BitCount
+    , rawExponentWidth    :: BitCount
-	, rawSignificandWidth :: BitCount
+    , rawSignificandWidth :: BitCount
-	}
+    }
-	deriving (Show)
+    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 == 16         = 5
-	| k == 32         = 8
+    | k == 32         = 8
-	| k `mod` 32 == 0 = ceiling (4 * logBase 2 (fromIntegral k)) - 13
+    | k `mod` 32 == 0 = ceiling (4 * logBase 2 (fromIntegral k)) - 13
-	| otherwise       = error "Invalid length of floating-point value"
+    | 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
+    step acc w     = shiftL acc 8 + fromIntegral w
-	bitCount'      = bitsInWord8 bs
+    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)
+    sliced = (x .&. startMask) `bitShiftR` (xBitCount - e)
-	startMask = n1Bits (xBitCount - s)
+    startMask = n1Bits (xBitCount - s)
-	n1Bits n  = (2 `pow` n) - 1
+    n1Bits n  = (2 `pow` n) - 1
 \end{code}
 
 Integral version of {\tt (**)}