[Haskell-beginners] Printing the bits of an Int|Double
Stephen Tetley
stephen.tetley at gmail.com
Fri Dec 11 09:05:07 EST 2009
Hello M Xyz
Here's a module[1] that seems to work for single precision floats -
you might want to do some checking of random numbers with toAndFro
(there's plenty of room for errors).
The print functions is printBin uses showIntAtBase which doesn't pad
with leading zeros, you might want to add them.
Best wishes
Stephen
[1] I wrote it a while ago but checking this morning it had some
nefarious bugs in.
module PrintIeeeFloat where
import Data.Bits
import Data.Char
import Data.Word
import Numeric
const_B :: Int
const_B = 127
printBin :: (Fractional a,Ord a) => a -> ShowS
printBin a =
f s . showChar ' ' . f t . showChar ' ' . f u . showChar ' ' . f v
where
f = showIntAtBase 2 (chr . (48+))
(s,t,u,v) = packIEEESingle a
toAndFro :: (Fractional a, Ord a) => a -> a
toAndFro a = let (s,t,u,v) = packIEEESingle a in unpackIEEESingle s t u v
unpackIEEESingle :: Fractional a => Word8 -> Word8 -> Word8 -> Word8 -> a
unpackIEEESingle b24_31 b16_23 b8_15 b0_7 = sign $ fract * (2 ^^ expo)
where
sign = if b24_31 `testBit` 7 then negate else id
expo = exponent' b24_31 b16_23
fract = fraction b16_23 b8_15 b0_7
exponent' :: Word8 -> Word8 -> Int
exponent' a b = (a' `shiftL` 1) + (b' `shiftR` 7) - 127
where
a' = fromIntegral $ (a .&. 0x7f)
b' = fromIntegral $ (b .&. 0x80)
fraction :: Fractional a => Word8 -> Word8 -> Word8 -> a
fraction b16_24 b8_15 b0_7 = 1.0 + ((fromIntegral frac) / (2 ^^ 23))
where
frac :: Int
frac = (shiftL16 (b16_24 .&. 0x7f)) + (shiftL8 b8_15) + fromIntegral b0_7
packIEEESingle :: (Fractional a,Ord a) => a -> (Word8,Word8,Word8,Word8)
packIEEESingle a = (flipSign b24_31, exp_part+mant_part, b8_15, b0_7)
where
k = findPosExpo $ abs a
e = k + const_B
halfa = (abs a) / (2 ^^ fromIntegral k)
f = expand $ halfa - 1
(b24_31, exp_part) = expoWords e
(mant_part,b8_15, b0_7) = mantWords f
flipSign = if a > 0 then id else (`setBit` 7)
findPosExpo :: (Fractional a, Ord a) => a -> Int
findPosExpo r | r <= 0 = 0
| otherwise = step r 1
where
step r' k | r <= fromIntegral 2 ^^ k = k-1
| otherwise = step r' (k+1)
expand :: (Fractional a, Ord a) => a -> Word32
expand n = (`shiftR` 9) $ step n 0 id
where
step x ix f | x <= 0 = f (0::Word32)
| otherwise = let y = 1 / (2 ^^ (ix+1))
in if x >= y
then step (x-y) (ix+1) (f . (`setBit` (31-ix)))
else step x (ix+1) f
-- 7 bits left, 1 bit right
expoWords :: Int -> (Word8,Word8)
expoWords n = (left, right)
where
right = if n `testBit` 0 then 128 else 0
left = fromIntegral $ n `shiftR` 1
mantWords :: Word32 -> (Word8,Word8,Word8)
mantWords x = (a,b,c)
where
c = fromIntegral $ x .&. 0xff
b = fromIntegral $ (`shiftR` 8) $ x .&. 0xff00
a = fromIntegral $ (`shiftR` 16) $ x .&. 0xff0000
shiftL8 :: (Bits b, Integral b) => Word8 -> b
shiftL8 = (`shiftL` 8) . fromIntegral
shiftL16 :: (Bits b, Integral b) => Word8 -> b
shiftL16 = (`shiftL` 16) . fromIntegral
shiftL24 :: (Bits b, Integral b) => Word8 -> b
shiftL24 = (`shiftL` 24) . fromIntegral
w32be :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
w32be a b c d = (shiftL24 a) + (shiftL16 b) + (shiftL8 c) + fromIntegral d
2009/12/11 M Xyz <functionallyharmonious at yahoo.com>
>
> I've been trying to play around with binary data, but I haven't made much progress
> trying to print the bits of a Double. With help from #haskell I've made it this far:
>
> -- Printing the bits of an Int
> main = do putStrLn $ showIntAtBase 2 (chr . (48+)) z ""
>
> -- 103 = 1100111, after bit shifting 11001
> z = shiftR (103 :: Int64) 2
>
> This is as far as I got with Doubles:
>
> import Data.Binary.IEEE754
> import qualified Data.ByteString.Lazy as BS
> main = do BS.putStrLn $ runPut $ putFloat64be 4.123
>
> Instead of playing with ByteStrings, is there just a way to fill an Int64 with the bits of a Double (Similar to Java's long = Double.doubleToLongBits(double))?
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
More information about the Beginners
mailing list