Remove no longer used benchmark and code
authorJohan Tibell <johan.tibell@gmail.com>
Wed, 30 Mar 2011 13:27:27 +0000 (15:27 +0200)
committerJohan Tibell <johan.tibell@gmail.com>
Wed, 30 Mar 2011 13:27:27 +0000 (15:27 +0200)
benchmarks/Makefile
benchmarks/NewBenchmark.hs [deleted file]
benchmarks/NewBinary.hs [deleted file]

index 7923e46..64782cf 100644 (file)
@@ -1,4 +1,4 @@
-programs := builder bench bench-nb
+programs := builder bench
 
 .PHONY: all
 all: $(programs)
@@ -6,14 +6,10 @@ all: $(programs)
 builder: Builder.hs
        ghc --make -O2 Builder.hs -o builder -fforce-recomp -i../src
 
-bench:: Benchmark.hs MemBench.hs CBenchmark.o
+bench: Benchmark.hs MemBench.hs CBenchmark.o
        ghc --make -O2 -fliberate-case-threshold=1000 -fasm Benchmark.hs CBenchmark.o -o bench -fforce-recomp -i../src
        ./bench 100
 
-bench-nb::
-       ghc --make -O2 -fliberate-case-threshold=1000 NewBenchmark.hs -fasm -o bench-nb
-       ./bench-nb 
-
 CBenchmark.o: CBenchmark.c
        ghc -c -optc -O3 $< -o $@
 
diff --git a/benchmarks/NewBenchmark.hs b/benchmarks/NewBenchmark.hs
deleted file mode 100644 (file)
index 2148b84..0000000
+++ /dev/null
@@ -1,625 +0,0 @@
---
--- benchmark NewBinary
---
-
-module Main where
-
-import System.IO
-import Data.Word
-import NewBinary
-
-import Control.Exception
-import System.CPUTime
-import Numeric
-
-mb :: Int
-mb = 10
-
-main :: IO ()
-main = sequence_ 
-  [ test wordSize chunkSize mb
-  | wordSize  <- [1,2,4,8]
-  , chunkSize <- [1,2,4,8,16] ]
-
-time :: IO a -> IO Double
-time action = do
-    start <- getCPUTime
-    action
-    end   <- getCPUTime
-    return $! (fromIntegral (end - start)) / (10^12)
-
-test :: Int -> Int -> Int -> IO ()
-test wordSize chunkSize mb = do
-    let bytes :: Int
-        bytes = mb * 2^20
-        iterations = bytes `div` wordSize
-    putStr $ show mb ++ "MB of Word" ++ show (8 * wordSize)
-          ++ " in chunks of " ++ show chunkSize ++ ": "
-    h <- openBinMem bytes undefined
-    start <- tellBin h
-    putSeconds <- time $ do
-      doPut wordSize chunkSize h iterations
---      BinPtr n _ <- tellBin h
---      print n
-    getSeconds <- time $ do
-      seekBin h start
-      sum <- doGet wordSize chunkSize h iterations
-      evaluate sum
---      BinPtr n _ <- tellBin h
---      print (n, sum)
-    let putThroughput = fromIntegral mb / putSeconds
-        getThroughput = fromIntegral mb / getSeconds
-    putStrLn $ showFFloat (Just 2) putThroughput "MB/s write, "
-            ++ showFFloat (Just 2) getThroughput "MB/s read"
-
-doPut :: Int -> Int -> BinHandle -> Int -> IO ()
-doPut wordSize chunkSize =
-  case (wordSize, chunkSize) of
-    (1, 1)  -> putWord8N1
-    (1, 2)  -> putWord8N2
-    (1, 4)  -> putWord8N4
-    (1, 8)  -> putWord8N8
-    (1, 16) -> putWord8N16
-    (2, 1)  -> putWord16N1
-    (2, 2)  -> putWord16N2
-    (2, 4)  -> putWord16N4
-    (2, 8)  -> putWord16N8
-    (2, 16) -> putWord16N16
-    (4, 1)  -> putWord32N1
-    (4, 2)  -> putWord32N2
-    (4, 4)  -> putWord32N4
-    (4, 8)  -> putWord32N8
-    (4, 16) -> putWord32N16
-    (8, 1)  -> putWord64N1
-    (8, 2)  -> putWord64N2
-    (8, 4)  -> putWord64N4
-    (8, 8)  -> putWord64N8
-    (8, 16) -> putWord64N16
-
-putWord8 :: BinHandle -> Word8 -> IO ()
-putWord8 = put_
-{-# INLINE putWord8 #-}
-
-putWord16be :: BinHandle -> Word16 -> IO ()
-putWord16be = put_
-{-# INLINE putWord16be #-}
-
-putWord32be :: BinHandle -> Word32 -> IO ()
-putWord32be = put_
-{-# INLINE putWord32be #-}
-
-putWord64be :: BinHandle -> Word64 -> IO ()
-putWord64be = put_
-{-# INLINE putWord64be #-}
-
-getWord8 :: BinHandle -> IO Word8
-getWord8 = get
-{-# INLINE getWord8 #-}
-
-getWord16be :: BinHandle -> IO Word16
-getWord16be = get
-{-# INLINE getWord16be #-}
-
-getWord32be :: BinHandle -> IO Word32
-getWord32be = get
-{-# INLINE getWord32be #-}
-
-getWord64be :: BinHandle -> IO Word64
-getWord64be = get
-{-# INLINE getWord64be #-}
-
-putWord8N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord8 hnd (s+0)
-          loop (s+1) (n-1)
-
-putWord8N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord8 hnd (s+0)
-          putWord8 hnd (s+1)
-          loop (s+2) (n-2)
-
-putWord8N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord8 hnd (s+0)
-          putWord8 hnd (s+1)
-          putWord8 hnd (s+2)
-          putWord8 hnd (s+3)
-          loop (s+4) (n-4)
-
-putWord8N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord8 hnd (s+0)
-          putWord8 hnd (s+1)
-          putWord8 hnd (s+2)
-          putWord8 hnd (s+3)
-          putWord8 hnd (s+4)
-          putWord8 hnd (s+5)
-          putWord8 hnd (s+6)
-          putWord8 hnd (s+7)
-          loop (s+8) (n-8)
-
-putWord8N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord8 hnd (s+0)
-          putWord8 hnd (s+1)
-          putWord8 hnd (s+2)
-          putWord8 hnd (s+3)
-          putWord8 hnd (s+4)
-          putWord8 hnd (s+5)
-          putWord8 hnd (s+6)
-          putWord8 hnd (s+7)
-          putWord8 hnd (s+8)
-          putWord8 hnd (s+9)
-          putWord8 hnd (s+10)
-          putWord8 hnd (s+11)
-          putWord8 hnd (s+12)
-          putWord8 hnd (s+13)
-          putWord8 hnd (s+14)
-          putWord8 hnd (s+15)
-          loop (s+16) (n-16)
-
-
-putWord16N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord16be hnd (s+0)
-          loop (s+1) (n-1)
-
-putWord16N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord16be hnd (s+0)
-          putWord16be hnd (s+1)
-          loop (s+2) (n-2)
-
-putWord16N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord16be hnd (s+0)
-          putWord16be hnd (s+1)
-          putWord16be hnd (s+2)
-          putWord16be hnd (s+3)
-          loop (s+4) (n-4)
-
-putWord16N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord16be hnd (s+0)
-          putWord16be hnd (s+1)
-          putWord16be hnd (s+2)
-          putWord16be hnd (s+3)
-          putWord16be hnd (s+4)
-          putWord16be hnd (s+5)
-          putWord16be hnd (s+6)
-          putWord16be hnd (s+7)
-          loop (s+8) (n-8)
-
-putWord16N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord16be hnd (s+0)
-          putWord16be hnd (s+1)
-          putWord16be hnd (s+2)
-          putWord16be hnd (s+3)
-          putWord16be hnd (s+4)
-          putWord16be hnd (s+5)
-          putWord16be hnd (s+6)
-          putWord16be hnd (s+7)
-          putWord16be hnd (s+8)
-          putWord16be hnd (s+9)
-          putWord16be hnd (s+10)
-          putWord16be hnd (s+11)
-          putWord16be hnd (s+12)
-          putWord16be hnd (s+13)
-          putWord16be hnd (s+14)
-          putWord16be hnd (s+15)
-          loop (s+16) (n-16)
-
-
-putWord32N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord32be hnd (s+0)
-          loop (s+1) (n-1)
-
-putWord32N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord32be hnd (s+0)
-          putWord32be hnd (s+1)
-          loop (s+2) (n-2)
-
-putWord32N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord32be hnd (s+0)
-          putWord32be hnd (s+1)
-          putWord32be hnd (s+2)
-          putWord32be hnd (s+3)
-          loop (s+4) (n-4)
-
-putWord32N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord32be hnd (s+0)
-          putWord32be hnd (s+1)
-          putWord32be hnd (s+2)
-          putWord32be hnd (s+3)
-          putWord32be hnd (s+4)
-          putWord32be hnd (s+5)
-          putWord32be hnd (s+6)
-          putWord32be hnd (s+7)
-          loop (s+8) (n-8)
-
-putWord32N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord32be hnd (s+0)
-          putWord32be hnd (s+1)
-          putWord32be hnd (s+2)
-          putWord32be hnd (s+3)
-          putWord32be hnd (s+4)
-          putWord32be hnd (s+5)
-          putWord32be hnd (s+6)
-          putWord32be hnd (s+7)
-          putWord32be hnd (s+8)
-          putWord32be hnd (s+9)
-          putWord32be hnd (s+10)
-          putWord32be hnd (s+11)
-          putWord32be hnd (s+12)
-          putWord32be hnd (s+13)
-          putWord32be hnd (s+14)
-          putWord32be hnd (s+15)
-          loop (s+16) (n-16)
-
-putWord64N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord64be hnd (s+0)
-          loop (s+1) (n-1)
-
-putWord64N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord64be hnd (s+0)
-          putWord64be hnd (s+1)
-          loop (s+2) (n-2)
-
-putWord64N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord64be hnd (s+0)
-          putWord64be hnd (s+1)
-          putWord64be hnd (s+2)
-          putWord64be hnd (s+3)
-          loop (s+4) (n-4)
-
-putWord64N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord64be hnd (s+0)
-          putWord64be hnd (s+1)
-          putWord64be hnd (s+2)
-          putWord64be hnd (s+3)
-          putWord64be hnd (s+4)
-          putWord64be hnd (s+5)
-          putWord64be hnd (s+6)
-          putWord64be hnd (s+7)
-          loop (s+8) (n-8)
-
-putWord64N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop _ 0 = return ()
-        loop s n = do
-          putWord64be hnd (s+0)
-          putWord64be hnd (s+1)
-          putWord64be hnd (s+2)
-          putWord64be hnd (s+3)
-          putWord64be hnd (s+4)
-          putWord64be hnd (s+5)
-          putWord64be hnd (s+6)
-          putWord64be hnd (s+7)
-          putWord64be hnd (s+8)
-          putWord64be hnd (s+9)
-          putWord64be hnd (s+10)
-          putWord64be hnd (s+11)
-          putWord64be hnd (s+12)
-          putWord64be hnd (s+13)
-          putWord64be hnd (s+14)
-          putWord64be hnd (s+15)
-          loop (s+16) (n-16)
-
-doGet :: Int -> Int -> BinHandle -> Int ->  IO Int
-doGet wordSize chunkSize hnd =
-  case (wordSize, chunkSize) of
-    (1, 1)  -> fmap fromIntegral . getWord8N1 hnd
-    (1, 2)  -> fmap fromIntegral . getWord8N2 hnd
-    (1, 4)  -> fmap fromIntegral . getWord8N4 hnd
-    (1, 8)  -> fmap fromIntegral . getWord8N8 hnd
-    (1, 16) -> fmap fromIntegral . getWord8N16 hnd
-    (2, 1)  -> fmap fromIntegral . getWord16N1 hnd
-    (2, 2)  -> fmap fromIntegral . getWord16N2 hnd
-    (2, 4)  -> fmap fromIntegral . getWord16N4 hnd
-    (2, 8)  -> fmap fromIntegral . getWord16N8 hnd
-    (2, 16) -> fmap fromIntegral . getWord16N16 hnd
-    (4, 1)  -> fmap fromIntegral . getWord32N1 hnd
-    (4, 2)  -> fmap fromIntegral . getWord32N2 hnd
-    (4, 4)  -> fmap fromIntegral . getWord32N4 hnd
-    (4, 8)  -> fmap fromIntegral . getWord32N8 hnd
-    (4, 16) -> fmap fromIntegral . getWord32N16 hnd
-    (8, 1)  -> fmap fromIntegral . getWord64N1 hnd
-    (8, 2)  -> fmap fromIntegral . getWord64N2 hnd
-    (8, 4)  -> fmap fromIntegral . getWord64N4 hnd
-    (8, 8)  -> fmap fromIntegral . getWord64N8 hnd
-    (8, 16) -> fmap fromIntegral . getWord64N16 hnd
-
-getWord8N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord8 hnd
-          loop (s+s0) (n-1)
-
-getWord8N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord8 hnd
-          s1 <- getWord8 hnd
-          loop (s+s0+s1) (n-2)
-
-getWord8N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord8 hnd
-          s1 <- getWord8 hnd
-          s2 <- getWord8 hnd
-          s3 <- getWord8 hnd
-          loop (s+s0+s1+s2+s3) (n-4)
-
-getWord8N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord8 hnd
-          s1 <- getWord8 hnd
-          s2 <- getWord8 hnd
-          s3 <- getWord8 hnd
-          s4 <- getWord8 hnd
-          s5 <- getWord8 hnd
-          s6 <- getWord8 hnd
-          s7 <- getWord8 hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7) (n-8)
-
-getWord8N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord8 hnd
-          s1 <- getWord8 hnd
-          s2 <- getWord8 hnd
-          s3 <- getWord8 hnd
-          s4 <- getWord8 hnd
-          s5 <- getWord8 hnd
-          s6 <- getWord8 hnd
-          s7 <- getWord8 hnd
-          s8 <- getWord8 hnd
-          s9 <- getWord8 hnd
-          s10 <- getWord8 hnd
-          s11 <- getWord8 hnd
-          s12 <- getWord8 hnd
-          s13 <- getWord8 hnd
-          s14 <- getWord8 hnd
-          s15 <- getWord8 hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7+s9+s10+s11+s12+s13+s14+s15) (n-16)
-
-
-getWord16N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord16be hnd
-          loop (s+s0) (n-1)
-
-getWord16N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord16be hnd
-          s1 <- getWord16be hnd
-          loop (s+s0+s1) (n-2)
-
-getWord16N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord16be hnd
-          s1 <- getWord16be hnd
-          s2 <- getWord16be hnd
-          s3 <- getWord16be hnd
-          loop (s+s0+s1+s2+s3) (n-4)
-
-getWord16N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord16be hnd
-          s1 <- getWord16be hnd
-          s2 <- getWord16be hnd
-          s3 <- getWord16be hnd
-          s4 <- getWord16be hnd
-          s5 <- getWord16be hnd
-          s6 <- getWord16be hnd
-          s7 <- getWord16be hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7) (n-8)
-
-getWord16N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord16be hnd
-          s1 <- getWord16be hnd
-          s2 <- getWord16be hnd
-          s3 <- getWord16be hnd
-          s4 <- getWord16be hnd
-          s5 <- getWord16be hnd
-          s6 <- getWord16be hnd
-          s7 <- getWord16be hnd
-          s8 <- getWord16be hnd
-          s9 <- getWord16be hnd
-          s10 <- getWord16be hnd
-          s11 <- getWord16be hnd
-          s12 <- getWord16be hnd
-          s13 <- getWord16be hnd
-          s14 <- getWord16be hnd
-          s15 <- getWord16be hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7+s9+s10+s11+s12+s13+s14+s15) (n-16)
-
-
-getWord32N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord32be hnd
-          loop (s+s0) (n-1)
-
-getWord32N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord32be hnd
-          s1 <- getWord32be hnd
-          loop (s+s0+s1) (n-2)
-
-getWord32N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord32be hnd
-          s1 <- getWord32be hnd
-          s2 <- getWord32be hnd
-          s3 <- getWord32be hnd
-          loop (s+s0+s1+s2+s3) (n-4)
-
-getWord32N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord32be hnd
-          s1 <- getWord32be hnd
-          s2 <- getWord32be hnd
-          s3 <- getWord32be hnd
-          s4 <- getWord32be hnd
-          s5 <- getWord32be hnd
-          s6 <- getWord32be hnd
-          s7 <- getWord32be hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7) (n-8)
-
-getWord32N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord32be hnd
-          s1 <- getWord32be hnd
-          s2 <- getWord32be hnd
-          s3 <- getWord32be hnd
-          s4 <- getWord32be hnd
-          s5 <- getWord32be hnd
-          s6 <- getWord32be hnd
-          s7 <- getWord32be hnd
-          s8 <- getWord32be hnd
-          s9 <- getWord32be hnd
-          s10 <- getWord32be hnd
-          s11 <- getWord32be hnd
-          s12 <- getWord32be hnd
-          s13 <- getWord32be hnd
-          s14 <- getWord32be hnd
-          s15 <- getWord32be hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7+s9+s10+s11+s12+s13+s14+s15) (n-16)
-
-getWord64N1 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord64be hnd
-          loop (s+s0) (n-1)
-
-getWord64N2 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord64be hnd
-          s1 <- getWord64be hnd
-          loop (s+s0+s1) (n-2)
-
-getWord64N4 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord64be hnd
-          s1 <- getWord64be hnd
-          s2 <- getWord64be hnd
-          s3 <- getWord64be hnd
-          loop (s+s0+s1+s2+s3) (n-4)
-
-getWord64N8 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord64be hnd
-          s1 <- getWord64be hnd
-          s2 <- getWord64be hnd
-          s3 <- getWord64be hnd
-          s4 <- getWord64be hnd
-          s5 <- getWord64be hnd
-          s6 <- getWord64be hnd
-          s7 <- getWord64be hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7) (n-8)
-
-getWord64N16 hnd = loop 0
-  where loop s n | s `seq` n `seq` False = undefined
-        loop s 0 = return s
-        loop s n = do
-          s0 <- getWord64be hnd
-          s1 <- getWord64be hnd
-          s2 <- getWord64be hnd
-          s3 <- getWord64be hnd
-          s4 <- getWord64be hnd
-          s5 <- getWord64be hnd
-          s6 <- getWord64be hnd
-          s7 <- getWord64be hnd
-          s8 <- getWord64be hnd
-          s9 <- getWord64be hnd
-          s10 <- getWord64be hnd
-          s11 <- getWord64be hnd
-          s12 <- getWord64be hnd
-          s13 <- getWord64be hnd
-          s14 <- getWord64be hnd
-          s15 <- getWord64be hnd
-          loop (s+s0+s1+s2+s3+s4+s5+s6+s7+s9+s10+s11+s12+s13+s14+s15) (n-16)
diff --git a/benchmarks/NewBinary.hs b/benchmarks/NewBinary.hs
deleted file mode 100644 (file)
index 9c7d9c8..0000000
+++ /dev/null
@@ -1,1006 +0,0 @@
-{-# OPTIONS -cpp -fglasgow-exts  #-}
---
--- (c) The University of Glasgow 2002
---
--- Binary I/O library, with special tweaks for GHC
---
--- Based on the nhc98 Binary library, which is copyright
--- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.
--- Under the terms of the license for that software, we must tell you
--- where you can obtain the original version of the Binary library, namely
---     http://www.cs.york.ac.uk/fp/nhc98/
-
-module NewBinary
-  ( {-type-}  Bin,
-    {-class-} Binary(..),
-    {-type-}  BinHandle(..),
-
-   openBinIO, 
-   openBinIO_,
-   openBinMem,
---   closeBin,
-
---   getUserData,
-
-   seekBin,
-   tellBin,
-   tellBinByte,
-   castBin,
-
-   writeBinMem,
-   readBinMem,
-
-   isEOFBin,
-
-   -- for writing instances:
-   putByte,
-   getByte,
-
-   -- bit stuff
-   putBits,
-   getBits,
-   flushByte,
-   finishByte,
-   putMaybeInt,
-   getMaybeInt,
-
-   -- lazy Bin I/O
-   lazyGet,
-   lazyPut,
-
-   -- GHC only:
-   ByteArray(..),
-   getByteArray,
-   putByteArray,
-
---   getBinFileWithDict,    -- :: Binary a => FilePath -> IO a
---   putBinFileWithDict,    -- :: Binary a => FilePath -> Module -> a -> IO ()
-
-  ) where
-
-#include "MachDeps.h"
-
-import GHC.Exts
-import GHC.IOBase
-import GHC.Real
-import Data.Array.IO        ( IOUArray )
-import Data.Bits
-import Data.Int
-import Data.Word
-import Data.Char
-import Control.Monad
-import Control.Exception
-import Data.Array
-import Data.Array.IO
-import Data.Array.Base
-import System.IO as IO
-import System.IO.Error      ( mkIOError, eofErrorType )
-import GHC.Handle       
-import System.IO
-
-import GHC.Exts
-#if __GLASGOW_HASKELL__ >= 504
-import GHC.IOBase
-import Data.Word
-import Data.Bits
-#else
-import PrelIOBase
-import Word
-import Bits
-#endif
-
-#ifndef SIZEOF_HSINT
-#define SIZEOF_HSINT  INT_SIZE_IN_BYTES
-#endif
-
-#if __GLASGOW_HASKELL__ < 503
-type BinArray = MutableByteArray RealWorld Int
-newArray_ bounds     = stToIO (newCharArray bounds)
-unsafeWrite arr ix e = stToIO (writeWord8Array arr ix e)
-unsafeRead  arr ix   = stToIO (readWord8Array arr ix)
-
-hPutArray h arr sz   = hPutBufBA h arr sz
-hGetArray h sz       = hGetBufBA h sz
-
-mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> Exception
-mkIOError t location maybe_hdl maybe_filename
-  = IOException (IOError maybe_hdl t location ""
-                 maybe_filename
-        )
-
-eofErrorType = EOF
-
-#ifndef SIZEOF_HSINT
-#define SIZEOF_HSINT  INT_SIZE_IN_BYTES
-#endif
-
-#ifndef SIZEOF_HSWORD
-#define SIZEOF_HSWORD WORD_SIZE_IN_BYTES
-#endif
-
-#else
-type BinArray = IOUArray Int Word8
-#endif
-
-data BinHandle
-  = BinMem {        -- binary data stored in an unboxed array
-     off_r :: !FastMutInt,      -- the current offset
-     sz_r  :: !FastMutInt,      -- size of the array (cached)
-     arr_r :: !(IORef BinArray),    -- the array (bounds: (0,size-1))
-     bit_off_r :: !FastMutInt,          -- the bit offset (see end of file)
-     bit_cache_r :: !FastMutInt           -- the bit cache  (see end of file)
-    }
-    -- XXX: should really store a "high water mark" for dumping out
-    -- the binary data to a file.
-
-  | BinIO {     -- binary data stored in a file
-     off_r :: !FastMutInt,      -- the current offset (cached)
-     hdl   :: !IO.Handle,               -- the file handle (must be seekable)
-     bit_off_r :: !FastMutInt,          -- the bit offset (see end of file)
-     bit_cache_r :: !FastMutInt           -- the bit cache  (see end of file)
-   }
-    -- cache the file ptr in BinIO; using hTell is too expensive
-    -- to call repeatedly.  If anyone else is modifying this Handle
-    -- at the same time, we'll be screwed.
-
-data Bin a = BinPtr !Int !Int -- byte/bit
-  deriving (Eq, Ord, Show, Bounded)
-
-castBin :: Bin a -> Bin b
-castBin (BinPtr i j) = BinPtr i j
-
-class Binary a where
-    put_   :: BinHandle -> a -> IO ()
-    put    :: BinHandle -> a -> IO (Bin a)
-    get    :: BinHandle -> IO a
-
-    -- define one of put_, put.  Use of put_ is recommended because it
-    -- is more likely that tail-calls can kick in, and we rarely need the
-    -- position return value.
-    put_ bh a = do put bh a; return ()
-    put bh a  = do p <- tellBin bh; put_ bh a; return p
-
-putAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()
-putAt bh p x = do seekBin bh p; put bh x; return ()
-
-getAt  :: Binary a => BinHandle -> Bin a -> IO a
-getAt bh p = do seekBin bh p; get bh
-
-openBinIO_ :: IO.Handle -> IO BinHandle
-openBinIO_ h = openBinIO h noBinHandleUserData
-
-newZeroInt = do r <- newFastMutInt; writeFastMutInt r 0; return r
-
--- openBinIO :: IO.Handle -> Module -> IO BinHandle
-openBinIO :: forall t. Handle -> t -> IO BinHandle
-openBinIO h mod = do
-  r <- newZeroInt
-  o <- newZeroInt
-  c <- newZeroInt
---  state <- newWriteState mod
-  return (BinIO r h o c)
-
---openBinMem :: Int -> Module -> IO BinHandle
-openBinMem :: forall t. Int -> t -> IO BinHandle
-openBinMem size mod
- | size <= 0 = error "Data.Binary.openBinMem: size must be > 0"   -- fix, was ">= 0"
- | otherwise = do
-   arr <- newArray_ (0,size-1)
-   arr_r <- newIORef arr
-   ix_r <- newFastMutInt
-   writeFastMutInt ix_r 0
-   sz_r <- newFastMutInt
-   writeFastMutInt sz_r size
-   o <- newZeroInt
-   c <- newZeroInt
---   state <- newWriteState mod
-   return (BinMem ix_r sz_r arr_r o c)
-
-noBinHandleUserData = error "Binary.BinHandle: no user data"
-
---getUserData :: BinHandle -> BinHandleState
---getUserData bh = state bh
-
-tellBin :: BinHandle -> IO (Bin a)
-tellBin (BinIO r _ o _)   =  do ix <- readFastMutInt r; bix <- readFastMutInt o; return (BinPtr ix bix)
-tellBin (BinMem r _ _ o _) = do ix <- readFastMutInt r; bix <- readFastMutInt o; return (BinPtr ix bix)
-
-tellBinByte (BinIO r _ _ _)    = do ix <- readFastMutInt r; return ix
-tellBinByte (BinMem r _ _ _ _) = do ix <- readFastMutInt r; return ix
-
-seekBin :: BinHandle -> Bin a -> IO ()
-seekBin bh@(BinIO ix_r h o c) (BinPtr p bit) = do 
-  writeFastMutInt ix_r p
-  writeFastMutInt o 0
-  writeFastMutInt c 0
-  hSeek h AbsoluteSeek (fromIntegral p)
-  when (bit /= 0) $ getBits bh bit >> return ()
-  return ()
-seekBin h@(BinMem ix_r sz_r a o c) (BinPtr p bit) = do
-  sz <- readFastMutInt sz_r
-  if (p >= sz)
-    then do expandBin h p
-            writeFastMutInt ix_r p
-            writeFastMutInt o 0
-            writeFastMutInt c 0
-            when (bit /= 0) $ getBits h bit >> return ()
-            return ()
-
-    else do writeFastMutInt ix_r p
-            writeFastMutInt o 0
-            writeFastMutInt c 0
-            when (bit /= 0) $ getBits h bit >> return ()
-            return ()
-
-isEOFBin :: BinHandle -> IO Bool
-isEOFBin (BinMem ix_r sz_r a _ _) = do
-  ix <- readFastMutInt ix_r
-  sz <- readFastMutInt sz_r
-  return (ix >= sz)
-isEOFBin (BinIO ix_r h _ _) = hIsEOF h
-
-writeBinMem :: BinHandle -> FilePath -> IO ()
-writeBinMem (BinIO _ _ _ _) _ = error "Data.Binary.writeBinMem: not a memory handle"
-writeBinMem bh@(BinMem ix_r sz_r arr_r bit_off_r bit_cache_r) fn = do
-  flushByte bh
-  h <- openBinaryFile fn WriteMode
-  arr <- readIORef arr_r
-  ix  <- readFastMutInt ix_r
-  hPutArray h arr ix
-  hClose h
-
-flushByte :: BinHandle -> IO ()
-flushByte bh = do
-  bit_off <- readFastMutInt (bit_off_r bh)
-  if bit_off == 0
-    then return ()
-    else putBits bh (8 - bit_off) 0
-
-finishByte :: BinHandle -> IO ()
-finishByte bh = do
-  bit_off <- readFastMutInt (bit_off_r bh)
-  if bit_off == 0
-    then return ()
-    else getBits bh (8 - bit_off) >> return ()
-
-readBinMem :: FilePath -> IO BinHandle
-readBinMem filename = do
-  h <- openBinaryFile filename ReadMode
-  filesize' <- hFileSize h
-  let filesize = fromIntegral filesize'
-  arr <- newArray_ (0,filesize-1)
-  count <- hGetArray h arr filesize
-  when (count /= filesize)
-    (error ("Binary.readBinMem: only read " ++ show count ++ " bytes"))
-  hClose h
-  arr_r <- newIORef arr
-  ix_r <- newFastMutInt
-  writeFastMutInt ix_r 0
-  sz_r <- newFastMutInt
-  writeFastMutInt sz_r filesize
-  bit_off_r <- newZeroInt
-  bit_cache_r <- newZeroInt
-  return (BinMem {-initReadState-} ix_r sz_r arr_r bit_off_r bit_cache_r)
-
--- expand the size of the array to include a specified offset
-expandBin :: BinHandle -> Int -> IO ()
-expandBin (BinMem ix_r sz_r arr_r _ _) off = do
-   sz <- readFastMutInt sz_r
-   let sz' = head (dropWhile (<= off) (iterate (* 2) sz))
-   arr <- readIORef arr_r
-   arr' <- newArray_ (0,sz'-1)
-   sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i
-         | i <- [ 0 .. sz-1 ] ]
-   writeFastMutInt sz_r sz'
-   writeIORef arr_r arr'
---   hPutStrLn stderr ("expanding to size: " ++ show sz')
-   return ()
-expandBin (BinIO _ _ _ _) _ = return ()
-    -- no need to expand a file, we'll assume they expand by themselves.
-
--- -----------------------------------------------------------------------------
--- Low-level reading/writing of bytes
-
-putWord8 :: BinHandle -> Word8 -> IO ()
-putWord8 h@(BinMem ix_r sz_r arr_r bit_off_r bit_cache_r) w = do
-    bit_off <- readFastMutInt bit_off_r
-    if bit_off /= 0 then putBits h 8 w else do   -- only do standard putWord8 if bit_off == 0
-    ix <- readFastMutInt ix_r
-    sz <- readFastMutInt sz_r
-    -- double the size of the array if it overflows
-    if (ix >= sz) 
-        then do expandBin h ix
-                putWord8 h w
-        else do arr <- readIORef arr_r
-                unsafeWrite arr ix w
-                writeFastMutInt ix_r (ix+1)
-                return ()
-
-putWord8 bh@(BinIO ix_r h bit_off_r bit_cache_r) w = do
-    bit_off <- readFastMutInt bit_off_r
-    if bit_off /= 0 then putBits bh 8 w else do
-        ix <- readFastMutInt ix_r
-        hPutChar h (chr (fromIntegral w))   -- XXX not really correct
-        writeFastMutInt ix_r (ix+1)
-        return ()
-
-putByteNoBits :: BinHandle -> Word8 -> IO ()
-putByteNoBits h@(BinMem ix_r sz_r arr_r _ _) w = do
-    ix <- readFastMutInt ix_r
-    sz <- readFastMutInt sz_r
-    -- double the size of the array if it overflows
-    if (ix >= sz) 
-        then do expandBin h ix
-                putByteNoBits h w
-        else do arr <- readIORef arr_r
-                unsafeWrite arr ix w
-                writeFastMutInt ix_r (ix+1)
-                return ()
-
-putByteNoBits bh@(BinIO ix_r h _ _) w = do
-    hPutChar h (chr (fromIntegral w))   -- XXX not really correct
-    incFastMutInt ix_r
-    return ()
-
-getByteNoBits :: BinHandle -> IO Word8
-getByteNoBits h@(BinMem ix_r sz_r arr_r _ _) = do
-    ix <- readFastMutInt ix_r
-    sz <- readFastMutInt sz_r
-    when (ix >= sz)  $
-        throw (IOException $ mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
-    arr <- readIORef arr_r
-    w <- unsafeRead arr ix
-    writeFastMutInt ix_r (ix+1)
-    return w
-
-getByteNoBits bh@(BinIO ix_r h _ _) = do
-    c <- hGetChar h
-    incFastMutInt ix_r
-    return $! (fromIntegral (ord c))    -- XXX not really correct
-
-getWord8 :: BinHandle -> IO Word8
-getWord8 h@(BinMem ix_r sz_r arr_r bit_off_r _) = do
-    bit_off <- readFastMutInt bit_off_r
-    if bit_off /= 0 then getBits h 8 else do
-    ix <- readFastMutInt ix_r
-    sz <- readFastMutInt sz_r
-    when (ix >= sz)  $
-        throw (IOException $ mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
-    arr <- readIORef arr_r
-    w <- unsafeRead arr ix
-    writeFastMutInt ix_r (ix+1)
-    return w
-getWord8 bh@(BinIO ix_r h bit_off_r _) = do
-    bit_off <- readFastMutInt bit_off_r
-    if bit_off /= 0 then getBits bh 8 else do
-    ix <- readFastMutInt ix_r
-    c <- hGetChar h
-    writeFastMutInt ix_r (ix+1)
-    return $! (fromIntegral (ord c))    -- XXX not really correct
-
-putByte :: BinHandle -> Word8 -> IO ()
-putByte bh w = put_ bh w
-
-getByte :: BinHandle -> IO Word8
-getByte = getWord8
-
--- -----------------------------------------------------------------------------
--- Bit functions
-
-putBits :: BinHandle -> Int -> Word8 -> IO ()
-putBits bh num_bits bits {- | num_bits == 0 = return ()
-                         | num_bits <  0 = error "putBits cannot write negative numbers of bits"
-                         | num_bits >  8 = error "putBits cannot write more than 8 bits at a time"
-                         | otherwise    -} = do
-  bit_off <- readFastMutInt (bit_off_r bh)
-  if num_bits + bit_off < 8
-    then do incFastMutIntBy (bit_off_r bh) num_bits
-            orFastMutInt (bit_cache_r bh) (bits `shiftL` bit_off)
-    else if num_bits + bit_off == 8
-           then do writeFastMutInt (bit_off_r bh) 0
-                   bit_cache <- {-# SCC "bc1" #-} readFastMutInt (bit_cache_r bh) >>= return . fromIntegral
-                   writeFastMutInt (bit_cache_r bh) 0
-                   --putByte bh (bit_cache .|. (bits `shiftL` bit_off))    -- won't call putBits because bit_off_r == 0
-                   putByteNoBits bh (bit_cache .|. (bits `shiftL` bit_off))
-
-           else do let leftover_bits = 8 - bit_off                       -- we are going over a byte boundary
-                   bit_cache <- {-# SCC "bc2" #-} readFastMutInt (bit_cache_r bh) >>= \x -> return ({-# SCC "fi" #-} fromIntegral x)
-                   writeFastMutInt (bit_off_r bh) 0
-                   writeFastMutInt (bit_cache_r bh) 0
-                   {- putByte bh (bit_cache .|. (bits `shiftL` bit_off))  -}  -- won't call putBits
-                   putByteNoBits bh (bit_cache .|. (bits `shiftL` bit_off))
-                   putBits bh (num_bits - leftover_bits) (bits `shiftR` leftover_bits)
-
-getBits :: BinHandle -> Int -> IO Word8
-getBits bh num_bits {- | num_bits == 0 = return 0
-                    | num_bits <  0 = error "getBits cannot read negative numbers of bits"
-                    | num_bits >  8 = error "getBits cannot read more than 8 bits at a time"
-                    | otherwise     -} = do
-  bit_off <- readFastMutInt (bit_off_r bh)
-  if bit_off == 0
-    then do bit_cache <- getByte bh
-            if num_bits == 8
-              then do writeFastMutInt (bit_off_r   bh) 0
-                      writeFastMutInt (bit_cache_r bh) 0
-                      return bit_cache
-              else do writeFastMutInt (bit_off_r   bh) (fromIntegral num_bits)
-                      writeFastMutInt (bit_cache_r bh) (fromIntegral bit_cache)
-                      return (bit_cache .&. bit_mask num_bits)
-    else if bit_off + num_bits < 8
-    then do incFastMutIntBy (bit_off_r bh) num_bits
-            bit_cache <- readFastMutInt (bit_cache_r bh) >>= return . fromIntegral
-            return ((bit_cache `shiftR` bit_off) .&. bit_mask num_bits)
-    else if bit_off + num_bits == 8
-    then do writeFastMutInt (bit_off_r bh) 0
-            bit_cache <- readFastMutInt (bit_cache_r bh) >>= return . fromIntegral
-            writeFastMutInt (bit_cache_r bh) 0
-            return ((bit_cache `shiftR` bit_off) .&. bit_mask num_bits)
-    else do let leftover_bits = 8 - bit_off
-            bit_cache <- readFastMutInt (bit_cache_r bh) >>= return . fromIntegral
-            let bits = (bit_cache `shiftR` bit_off) .&. bit_mask leftover_bits
-            writeFastMutInt (bit_cache_r bh) 0
-            writeFastMutInt (bit_off_r   bh) 0
-            {- bit_cache <- getByte bh -}
-            -- use a version that doesn't care about bits
-            bit_cache <- getByteNoBits bh
-            writeFastMutInt (bit_off_r   bh) (num_bits - leftover_bits)
-            writeFastMutInt (bit_cache_r bh) (fromIntegral bit_cache)
-            return (bits .|. ((bit_cache .&. bit_mask (num_bits - leftover_bits)) `shiftL` leftover_bits))
-
-            
-bit_mask n = (complement 0) `shiftR` (8 - n)
-
--- -----------------------------------------------------------------------------
--- Primitve Word writes
-
-instance Binary Word8 where
-  put_ = putWord8
-  get  = getWord8
-
-instance Binary Word16 where
-  put_ h w = do -- XXX too slow.. inline putWord8?
-    putByte h (fromIntegral (w `shiftR` 8))
-    putByte h (fromIntegral (w .&. 0xff))
-  get h = do
-    w1 <- getWord8 h
-    w2 <- getWord8 h
-    return $! ((fromIntegral w1 `shiftL` 8) .|. fromIntegral w2)
-
-
-instance Binary Word32 where
-  put_ h w = do
-    putByte h (fromIntegral (w `shiftR` 24))
-    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 8)  .&. 0xff))
-    putByte h (fromIntegral (w .&. 0xff))
-  get h = do
-    w1 <- getWord8 h
-    w2 <- getWord8 h
-    w3 <- getWord8 h
-    w4 <- getWord8 h
-    return $! ((fromIntegral w1 `shiftL` 24) .|. 
-           (fromIntegral w2 `shiftL` 16) .|. 
-           (fromIntegral w3 `shiftL`  8) .|. 
-           (fromIntegral w4))
-
-
-instance Binary Word64 where
-  put_ h w = do
-    putByte h (fromIntegral (w `shiftR` 56))
-    putByte h (fromIntegral ((w `shiftR` 48) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 40) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 32) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 24) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR`  8) .&. 0xff))
-    putByte h (fromIntegral (w .&. 0xff))
-  get h = do
-    w1 <- getWord8 h
-    w2 <- getWord8 h
-    w3 <- getWord8 h
-    w4 <- getWord8 h
-    w5 <- getWord8 h
-    w6 <- getWord8 h
-    w7 <- getWord8 h
-    w8 <- getWord8 h
-    return $! ((fromIntegral w1 `shiftL` 56) .|. 
-           (fromIntegral w2 `shiftL` 48) .|. 
-           (fromIntegral w3 `shiftL` 40) .|. 
-           (fromIntegral w4 `shiftL` 32) .|. 
-           (fromIntegral w5 `shiftL` 24) .|. 
-           (fromIntegral w6 `shiftL` 16) .|. 
-           (fromIntegral w7 `shiftL`  8) .|. 
-           (fromIntegral w8))
-
--- -----------------------------------------------------------------------------
--- Primitve Int writes
-
-instance Binary Int8 where
-  put_ h w = put_ h (fromIntegral w :: Word8)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word8))
-
-instance Binary Int16 where
-  put_ h w = put_ h (fromIntegral w :: Word16)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word16))
-
-instance Binary Int32 where
-  put_ h w = put_ h (fromIntegral w :: Word32)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word32))
-
-put31ofInt32 :: BinHandle -> Int32 -> IO ()
-put31ofInt32 h i = do
-    putBits h 7 (fromIntegral (w `shiftR` 24))
-    putBits h 8 (fromIntegral ((w `shiftR` 16) .&. 0xff))
-    putBits h 8 (fromIntegral ((w `shiftR` 8)  .&. 0xff))
-    putBits h 8 (fromIntegral (w .&. 0xff))
-    where w = fromIntegral i :: Word32
-
-get31ofInt32 :: BinHandle -> IO Int32
-get31ofInt32 h = do
-    w1 <- getBits  h 7
-    w2 <- getWord8 h
-    w3 <- getWord8 h
-    w4 <- getWord8 h
-    return $! ((fromIntegral w1 `shiftL` 24) .|. 
-           (fromIntegral w2 `shiftL` 16) .|. 
-           (fromIntegral w3 `shiftL`  8) .|. 
-           (fromIntegral w4))
-
-instance Binary Int64 where
-  put_ h w = put_ h (fromIntegral w :: Word64)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word64))
-
--- -----------------------------------------------------------------------------
--- Instances for standard types
-
-instance Binary () where
-    put_ bh () = return ()
-    get  _     = return ()
---    getF bh p  = case getBitsF bh 0 p of (_,b) -> ((),b)
-
-{- updated for bits
-instance Binary Bool where
-    put_ bh b = putByte bh (fromIntegral (fromEnum b))
-    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))
---    getF bh p = case getBitsF bh 1 p of (x,b) -> (toEnum x,b)
--}
-
-instance Binary Bool where
-    put_ bh True  = putBits bh 1 1
-    put_ bh False = putBits bh 1 0
-    get  bh = do b <- getBits bh 1; return (b == 1)
-
-instance Binary Char where
-    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)
-    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))
---    getF bh p = case getBitsF bh 8 p of (x,b) -> (toEnum x,b)
-
-instance Binary Int where
-#if SIZEOF_HSINT == 4
-    put_ bh i = put_ bh (fromIntegral i :: Int32)
-    get  bh = do
-    x <- get bh
-    return $! (fromIntegral (x :: Int32))
-#elif SIZEOF_HSINT == 8
-    put_ bh i = put_ bh (fromIntegral i :: Int64)
-    get  bh = do
-    x <- get bh
-    return $! (fromIntegral (x :: Int64))
-#else
-#error "unsupported sizeof(HsInt)"
-#endif
---    getF bh   = getBitsF bh 32
-
-{-
-instance Binary a => Binary [a] where
-    put_ bh []     = putByte bh 0
-    put_ bh (x:xs) = do putByte bh 1; put_ bh x; put_ bh xs
-    get bh         = do h <- getWord8 bh
-                        case h of
-                          0 -> return []
-                          _ -> do x  <- get bh
-                                  xs <- get bh
-                                  return (x:xs)
--}
-
-instance Binary a => Binary [a] where
-    put_ bh l = do
-       put_ bh (length l)
-       mapM (put_ bh) l
-       return ()
-    get bh = do
-       len <- get bh
-       mapM (\_ -> get bh) [1..(len::Int)]
-
-instance (Binary a, Binary b) => Binary (a,b) where
-    put_ bh (a,b) = do put_ bh a; put_ bh b
-    get bh        = do a <- get bh
-                       b <- get bh
-                       return (a,b)
-
-instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
-    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c
-    get bh          = do a <- get bh
-                         b <- get bh
-                         c <- get bh
-                         return (a,b,c)
-
-instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
-    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d
-    get bh          = do a <- get bh
-                         b <- get bh
-                         c <- get bh
-                         d <- get bh
-                         return (a,b,c,d)
-
-instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d,e) where
-    put_ bh (a,b,c,d,e) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e
-    get bh          = do a <- get bh
-                         b <- get bh
-                         c <- get bh
-                         d <- get bh
-                         e <- get bh
-                         return (a,b,c,d,e)
-
-instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d,e,f) where
-    put_ bh (a,b,c,d,e,f) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f
-    get bh          = do a <- get bh
-                         b <- get bh
-                         c <- get bh
-                         d <- get bh
-                         e <- get bh
-                         f <- get bh
-                         return (a,b,c,d,e,f)
-
-instance Binary a => Binary (Maybe a) where
-    put_ bh Nothing  = putByte bh 0
-    put_ bh (Just a) = do putByte bh 1; put_ bh a
-    get bh           = do h <- getWord8 bh
-                          case h of
-                            0 -> return Nothing
-                            _ -> do x <- get bh; return (Just x)
-
-putMaybeInt :: BinHandle -> Maybe Int -> IO ()
-getMaybeInt :: BinHandle -> IO (Maybe Int)
-putMaybeInt bh Nothing = putBits bh 1 0
-putMaybeInt bh (Just i) = do putBits bh 1 1; put31ofInt32 bh (fromIntegral i)
-
-getMaybeInt bh = do 
-  b <- getBits bh 1
-  case b of
-    0 -> return Nothing
-    _ -> do i <- get31ofInt32 bh
-            return (Just (fromIntegral i))
-
-{- RULES get = getMaybeInt -}
-
-{- SPECIALIZE put_ :: BinHandle -> Maybe Int -> IO () = putMaybeInt -}
-{- SPECIALIZE get  :: BinHandle -> IO (Maybe Int)     = getMaybeInt -}
-
-
-instance (Binary a, Binary b) => Binary (Either a b) where
-    put_ bh (Left  a) = do putByte bh 0; put_ bh a
-    put_ bh (Right b) = do putByte bh 1; put_ bh b
-    get bh            = do h <- getWord8 bh
-                           case h of
-                             0 -> do a <- get bh ; return (Left a)
-                             _ -> do b <- get bh ; return (Right b)
-
-instance Binary Integer where
-    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)
-    put_ bh (J# s# a#) = do
-        p <- putByte bh 1;
-        put_ bh (I# s#)
-        let sz# = sizeofByteArray# a#  -- in *bytes*
-        put_ bh (I# sz#)  -- in *bytes*
-        putByteArray bh a# sz#
-
-    get bh = do
-        b <- getByte bh
-        case b of
-          0 -> do (I# i#) <- get bh
-                  return (S# i#)
-          _ -> do (I# s#) <- get bh
-                  sz <- get bh
-                  (BA a#) <- getByteArray bh sz
-                  return (J# s# a#)
-
-putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()
-putByteArray bh a s# = loop 0#
-  where loop n# 
-           | n# ==# s# = return ()
-           | otherwise = do
-                putByte bh (indexByteArray a n#)
-                loop (n# +# 1#)
-
-getByteArray :: BinHandle -> Int -> IO ByteArray
-getByteArray bh (I# sz) = do
-  (MBA arr) <- newByteArray sz 
-  let loop n
-       | n ==# sz = return ()
-       | otherwise = do
-        w <- getByte bh 
-        writeByteArray arr n w
-        loop (n +# 1#)
-  loop 0#
-  freezeByteArray arr
-
-
-data ByteArray = BA ByteArray#
-data MBA = MBA (MutableByteArray# RealWorld)
-
-newByteArray :: Int# -> IO MBA
-newByteArray sz = IO $ \s ->
-  case newByteArray# sz s of { (# s, arr #) ->
-  (# s, MBA arr #) }
-
-freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray
-freezeByteArray arr = IO $ \s ->
-  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->
-  (# s, BA arr #) }
-
-writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()
-
-writeByteArray arr i w8 = IO $ \s ->
-  case fromIntegral w8 of { W# w# -> 
-  case writeCharArray# arr i (chr# (word2Int# w#)) s  of { s ->
-  (# s , () #) }}
-
-indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#)))
-
-instance (Integral a, Binary a) => Binary (Ratio a) where
-    put_ bh (a :% b) = do put_ bh a; put_ bh b
-    get bh = do a <- get bh; b <- get bh; return (a :% b)
-
-instance Binary (Bin a) where
-  put_ bh (BinPtr i j) = put_ bh (i,j)
-  get bh = do (i,j) <- get bh; return (BinPtr i j)
-
--- -----------------------------------------------------------------------------
--- Lazy reading/writing
-
-lazyPut :: Binary a => BinHandle -> a -> IO ()
-lazyPut bh a = do
-    -- output the obj with a ptr to skip over it:
-    pre_a <- tellBin bh
-    put_ bh pre_a   -- save a slot for the ptr
-    put_ bh a       -- dump the object
-    q <- tellBin bh     -- q = ptr to after object
-    putAt bh pre_a q    -- fill in slot before a with ptr to q
-    seekBin bh q    -- finally carry on writing at q
-
-lazyGet :: Binary a => BinHandle -> IO a
-lazyGet bh = do
-    p <- get bh     -- a BinPtr
-    p_a <- tellBin bh
-    a <- unsafeInterleaveIO (getAt bh p_a)
-    seekBin bh p -- skip over the object for now
-    return a
-
--- -----------------------------------------------------------------------------
--- BinHandleState
-{-
-type BinHandleState = 
-    (Module, 
-     IORef Int,
-     IORef (UniqFM (Int,FastString)),
-     Array Int FastString)
-
-initReadState :: BinHandleState
-initReadState = (undef, undef, undef, undef)
-
-newWriteState :: Module -> IO BinHandleState
-newWriteState m = do
-  j_r <- newIORef 0
-  out_r <- newIORef emptyUFM
-  return (m,j_r,out_r,undef)
-
-undef = error "Binary.BinHandleState"
-
--- -----------------------------------------------------------------------------
--- FastString binary interface
-
-getBinFileWithDict :: Binary a => FilePath -> IO a
-getBinFileWithDict file_path = do
-  bh <- Binary.readBinMem file_path
-  magic <- get bh
-  when (magic /= binaryInterfaceMagic) $
-    throwDyn (ProgramError (
-       "magic number mismatch: old/corrupt interface file?"))
-  dict_p <- Binary.get bh       -- get the dictionary ptr
-  data_p <- tellBin bh
-  seekBin bh dict_p
-  dict <- getDictionary bh
-  seekBin bh data_p
-  let (mod, j_r, out_r, _) = state bh
-  get bh{ state = (mod,j_r,out_r,dict) }
-
-initBinMemSize = (1024*1024) :: Int
-
-binaryInterfaceMagic = 0x1face :: Word32
-
-putBinFileWithDict :: Binary a => FilePath -> Module -> a -> IO ()
-putBinFileWithDict file_path mod a = do
-  bh <- openBinMem initBinMemSize mod
-  put_ bh binaryInterfaceMagic
-  p <- tellBin bh
-  put_ bh p     -- placeholder for ptr to dictionary
-  put_ bh a
-  let (_, j_r, fm_r, _) = state bh
-  j <- readIORef j_r
-  fm <- readIORef fm_r
-  dict_p <- tellBin bh
-  putAt bh p dict_p -- fill in the placeholder
-  seekBin bh dict_p -- seek back to the end of the file
-  putDictionary bh j (constructDictionary j fm)
-  writeBinMem bh file_path
-  
-type Dictionary = Array Int FastString
-    -- should be 0-indexed
-
-putDictionary :: BinHandle -> Int -> Dictionary -> IO ()
-putDictionary bh sz dict = do
-  put_ bh sz
-  mapM_ (putFS bh) (elems dict)
-
-getDictionary :: BinHandle -> IO Dictionary
-getDictionary bh = do 
-  sz <- get bh
-  elems <- sequence (take sz (repeat (getFS bh)))
-  return (listArray (0,sz-1) elems)
-
-constructDictionary :: Int -> UniqFM (Int,FastString) -> Dictionary
-constructDictionary j fm = array (0,j-1) (eltsUFM fm)
-
-putFS bh (FastString id l ba) = do
-  put_ bh (I# l)
-  putByteArray bh ba l
-putFS bh s = error ("Binary.put_(FastString): " ++ unpackFS s)
-    -- Note: the length of the FastString is *not* the same as
-    -- the size of the ByteArray: the latter is rounded up to a
-    -- multiple of the word size.
-  
-{- -- possible faster version, not quite there yet:
-getFS bh@BinMem{} = do
-  (I# l) <- get bh
-  arr <- readIORef (arr_r bh)
-  off <- readFastMutInt (off_r bh)
-  return $! (mkFastSubStringBA# arr off l)
--}
-getFS bh = do
-  (I# l) <- get bh
-  (BA ba) <- getByteArray bh (I# l)
-  return $! (mkFastSubStringBA# ba 0# l)
-
-instance Binary FastString where
-  put_ bh f@(FastString id l ba) =
-    case getUserData bh of { (_, j_r, out_r, dict) -> do
-    out <- readIORef out_r
-    let uniq = getUnique f
-    case lookupUFM out uniq of
-    Just (j,f)  -> put_ bh j
-    Nothing -> do
-       j <- readIORef j_r
-       put_ bh j
-       writeIORef j_r (j+1)
-       writeIORef out_r (addToUFM out uniq (j,f))
-    }
-  put_ bh s = error ("Binary.put_(FastString): " ++ show (unpackFS s))
-
-  get bh = do 
-    j <- get bh
-    case getUserData bh of (_, _, _, arr) -> return (arr ! j)
--}
-
-
-
-{----------------------------------------------------------------------
- ---------- Hal's Notes -----------------------------------------------
- ----------------------------------------------------------------------
-
-We are adding support for 
-
-  putBits   :: BinHandle -> Int -> Word8 -> IO ()
-  getBits   :: BinHandle -> Int -> IO Word8
-  flushBits :: BinHandle -> Int -> IO ()
-  closeHandle :: BinHandle -> IO ()
-
-where
-
-  `putBits bh num_bits bits' writes the right-most num_bits of bits to
-  bh.  `getBits bh num_bits` reads num_bits from bh and stores them in
-  the right-most positions of the result.  flushBits bh n alignes the
-  stream to the next 2^n bit boundary.  closeHandle flushes all
-  remaining bits and closes the handle.
-
-In order to implement this, we need to extend the BinHandles with two
-fields: bit_off_r :: Int and bit_cache :: Word8.  Based on this, the
-basic implementations look something like this:
-
-putBits bh num_bits bits =
-  if num_bits + bit_off_r <= 8
-    then bit_off_r += num_bits
-         add num_bits of bits to the tail of bit_cache
-         if bit_off_r == 8
-           then write bit_cache and set bit_cache = 0, bit_off_r = 0
-    else let leftover_bits = 8 - bit_off_r
-         add leftover_bits of bits to tail of bit_cache
-         write bit_cache and set bit_cache = 0, bit_off_r = 0
-         putBits bh (num_bits - leftover_bits) (bits >> leftover_bits)
-
-(note that this will recurse at most once)
-
-getBits bh num_bits =
-  if bit_off_r == 0
-    then bit_cache <- read a byte
-         bit_off_r = num_bits
-         if bit_off_r == 8, set bit_off_r = 0, bit_cache = 0
-    else if bit_off_r + num_bits <= 8
-           then bit_off_r += num_bits
-                bits = bits from bit_off_r -> bit_off_r+num_bits of bit_cache
-                if bit_off_r == 8, set bit_off_r = 0, bit_cache = 0
-                return bits
-           else let leftover_bits = 8 - bit_off_r
-                bits = (last leftover_bits from bit_cache) << (num_bits - leftover_bits)
-                bit_cache <- read a byte
-                bit_off_r = num_bits - leftover_bits
-                return (bits || first (num_bits - leftover_bits) of bit_cache)
-
-Now, we must also modify putByte/getByte.  In these, we do a quick
-check to see if bit_off_r == 0; if it does, then we just execute
-normally.  Otherwise, we just call putBits/getBits with num_bits=8.
-
-closeHandle bh =
-  if bit_off_r == 0
-    then close the handle
-    else write bit_cache and set bit_cache = 0, bit_off_r =0
-         close the handle
-
--}
-
-------------------------------------------------------------------------
-
-#if __GLASGOW_HASKELL__ < 411
-newByteArray# = newCharArray#
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-
-data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
-
-newFastMutInt :: IO FastMutInt
-newFastMutInt = IO $ \s ->
-  case newByteArray# size s of { (# s, arr #) ->
-  (# s, FastMutInt arr #) }
-  where I# size = SIZEOF_HSINT
-
-readFastMutInt :: FastMutInt -> IO Int
-readFastMutInt (FastMutInt arr) = IO $ \s ->
-  case readIntArray# arr 0# s of { (# s, i #) ->
-  (# s, I# i #) }
-
-writeFastMutInt :: FastMutInt -> Int -> IO ()
-writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
-  case writeIntArray# arr 0# i s of { s ->
-  (# s, () #) }
-
-incFastMutInt :: FastMutInt -> IO Int   -- Returns original value
-incFastMutInt (FastMutInt arr) = IO $ \s ->
-  case readIntArray# arr 0# s of { (# s, i #) ->
-  case writeIntArray# arr 0# (i +# 1#) s of { s ->
-  (# s, I# i #) } }
-
-incFastMutIntBy :: FastMutInt -> Int -> IO Int  -- Returns original value
-incFastMutIntBy (FastMutInt arr) (I# n) = IO $ \s ->
-  case readIntArray# arr 0# s of { (# s, i #) ->
-  case writeIntArray# arr 0# (i +# n) s of { s ->
-  (# s, I# i #) } }
-
--- we should optimize this: ask SimonM :)
-orFastMutInt :: FastMutInt -> Word8 -> IO ()
-orFastMutInt fmi w = do
-  i <- readFastMutInt fmi
-  writeFastMutInt fmi (i .|. (fromIntegral w))
-
-#endif
-