diff --git a/BitsQC.hs b/BitsQC.hs
index 1941c1d..07562c2 100644
--- a/BitsQC.hs
+++ b/BitsQC.hs
@@ -9,6 +9,7 @@ import Data.Binary.Put ( runPut )
 import Data.Binary.Bits
 import Data.Binary.Bits.Get
 import Data.Binary.Bits.Put
+import Data.Binary.Bits.BitOrder
 
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
@@ -17,7 +18,8 @@ import Control.Applicative
 import Data.Bits
 import Data.Word
 import Foreign.Storable
-import System.Random
+import Data.Traversable (traverse)
+import Data.Foldable (traverse_)
 
 import Test.Framework.Providers.QuickCheck2 ( testProperty )
 import Test.Framework.Runners.Console ( defaultMain )
@@ -36,7 +38,10 @@ tests =
       [ testProperty "prop_composite_case" prop_composite_case ]
 
   , testGroup "getByteString"
-      [ testProperty "prop_getByteString_negative" prop_getByteString_negative ]
+      [ testProperty "prop_getByteString_negative" prop_getByteString_negative 
+      , testProperty "prop_putByteString_getByteString" (prop_putByteString_getByteString :: BitOrder -> B.ByteString -> Property)
+      , testProperty "prop_putByteString_getByteString_many" (prop_putByteString_getByteString_many :: BitOrder -> [B.ByteString] -> Property)
+      ]
 
   , testGroup "getLazyByteString"
       [ testProperty "getLazyByteString == getByteString"
@@ -84,10 +89,10 @@ tests =
       ]
 
   , testGroup "prop_put_with_bitreq"
-      [ testProperty "Word8"  (prop_putget_with_bitreq :: W Word8  -> Property)
-      , testProperty "Word16" (prop_putget_with_bitreq :: W Word16 -> Property)
-      , testProperty "Word32" (prop_putget_with_bitreq :: W Word32 -> Property)
-      , testProperty "Word64" (prop_putget_with_bitreq :: W Word64 -> Property)
+      [ testProperty "Word8"  (prop_putget_with_bitreq :: BitOrder -> W Word8  -> Property)
+      , testProperty "Word16" (prop_putget_with_bitreq :: BitOrder -> W Word16 -> Property)
+      , testProperty "Word32" (prop_putget_with_bitreq :: BitOrder -> W Word32 -> Property)
+      , testProperty "Word64" (prop_putget_with_bitreq :: BitOrder -> W Word64 -> Property)
       ]
 
   , testGroup "prop_putget_list_simple"
@@ -112,10 +117,10 @@ tests =
       , testProperty "Word64" (prop_putget_list_with_bitreq :: W [Word64] -> Property)
       ]
   , testGroup "prop_bitget_bytestring_interspersed"
-      [ testProperty "Word8"  (prop_bitget_bytestring_interspersed :: W Word8  -> [B.ByteString] -> Property)
-      , testProperty "Word16" (prop_bitget_bytestring_interspersed :: W Word16 -> [B.ByteString] -> Property)
-      , testProperty "Word32" (prop_bitget_bytestring_interspersed :: W Word32 -> [B.ByteString] -> Property)
-      , testProperty "Word64" (prop_bitget_bytestring_interspersed :: W Word64 -> [B.ByteString] -> Property)
+      [ testProperty "Word8"  (prop_bitget_bytestring_interspersed :: BitOrder -> W Word8  -> [B.ByteString] -> Property)
+      , testProperty "Word16" (prop_bitget_bytestring_interspersed :: BitOrder -> W Word16 -> [B.ByteString] -> Property)
+      , testProperty "Word32" (prop_bitget_bytestring_interspersed :: BitOrder -> W Word32 -> [B.ByteString] -> Property)
+      , testProperty "Word64" (prop_bitget_bytestring_interspersed :: BitOrder -> W Word64 -> [B.ByteString] -> Property)
       ]
   , testGroup "Simulate programs"
       [ testProperty "primitive" prop_primitive
@@ -158,13 +163,28 @@ prop_getByteString_negative n =
   n < 1 ==>
     runGet (runBitGet (getByteString n)) L.empty == B.empty
 
-prop_putget_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => W a -> Property
-prop_putget_with_bitreq (W w) = property $
+prop_putByteString_getByteString :: BitOrder -> B.ByteString -> Property
+prop_putByteString_getByteString bo bs = property $ bs' == bs
+   where
+      n   = B.length bs
+      w   = runPut (runBitPut (withBitOrder bo (putByteString bs)))
+      bs' = runGet (runBitGet (withBitOrder bo (getByteString n))) w
+
+prop_putByteString_getByteString_many :: BitOrder -> [B.ByteString] -> Property
+prop_putByteString_getByteString_many bo bs = property $ bs' == bs
+   where
+      n   = fmap B.length bs
+      w   = runPut (runBitPut (withBitOrder bo (traverse_ putByteString bs)))
+      bs' = runGet (runBitGet (withBitOrder bo (traverse getByteString n))) w
+
+
+prop_putget_with_bitreq :: (BinaryBit a, Num a, Bits a, Ord a) => BitOrder -> W a -> Property
+prop_putget_with_bitreq bo (W w) = property $
   -- write all words with as many bits as it's required
   let p = putBits (bitreq w) w
       g = getBits (bitreq w)
-      lbs = runPut (runBitPut p)
-      w' = runGet (runBitGet g) lbs
+      lbs = runPut (runBitPut (withBitOrder bo p))
+      w' = runGet (runBitGet (withBitOrder bo g)) lbs
   in w == w'
 
 -- | Write a list of items. Each item is written with the maximum amount of
@@ -226,12 +246,12 @@ prop_bitget_with_put_from_binary (W ws) = property $
   in ws == ws'
 
 -- | Write each 'ByteString' with a variable sized value as a separator.
-prop_bitget_bytestring_interspersed :: (BinaryBit a, Binary a, Num a, Ord a, Bits a) => W a -> [B.ByteString] -> Property
-prop_bitget_bytestring_interspersed (W ws) bss = property $
+prop_bitget_bytestring_interspersed :: (BinaryBit a, Binary a, Num a, Ord a, Bits a) => BitOrder -> W a -> [B.ByteString] -> Property
+prop_bitget_bytestring_interspersed bo (W ws) bss = property $
   let p = mapM_ (\bs -> putBits (bitreq ws) ws >> putByteString bs) bss
       g = mapM (\bs -> (,) <$> getBits (bitreq ws) <*> getByteString (B.length bs)) bss
-      lbs = runPut (runBitPut p)
-      r = runGet (runBitGet g) lbs
+      lbs = runPut (runBitPut (withBitOrder bo p))
+      r = runGet (runBitGet (withBitOrder bo g)) lbs
   in map (ws,) bss == r
 
 -- | Test failing.
@@ -241,8 +261,8 @@ prop_fail lbs errMsg0 = forAll (choose (0, 8 * L.length lbs)) $ \len ->
       expectedBytesConsumed
         | bits == 0 = bytes
         | otherwise = bytes + 1
-      p = do getByteString (fromIntegral bytes)
-             getBits (fromIntegral bits) :: BitGet Word8
+      p = do _ <- getByteString (fromIntegral bytes)
+             _ <- getBits (fromIntegral bits) :: BitGet Word8
              fail errMsg0
       r = runGetIncremental (runBitGet p) `pushChunks` lbs
   in case r of
@@ -268,10 +288,10 @@ prop_bitreq (W w) = property $
 prop_composite_case :: Bool -> W Word16 -> Property
 prop_composite_case b (W w) = w < 0x8000 ==>
   let p = do putBool b
-             putWord16be 15 w
+             putWord16 15 w
       g = do v <- getBool
              case v of
-              True -> getWord16be 15
+              True -> getWord16 15
               False -> do
                 msb <- getWord8 7
                 lsb <- getWord8 8
@@ -374,11 +394,6 @@ instance (Arbitrary (W a), Arbitrary (W b), Arbitrary (W c)) => Arbitrary (W (a,
     arbitrary          = ((W .) .) . (,,) <$> arbitraryW <*> arbitraryW <*> arbitraryW
     shrink (W (a,b,c)) = ((W .) .) . (,,) <$> shrinkW a <*> shrinkW b <*> shrinkW c
 
-integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
-integralRandomR  (a,b) g = case randomR (fromIntegral a :: Integer,
-                                         fromIntegral b :: Integer) g of
-                            (x,g) -> (fromIntegral x, g)
-
 data Primitive
   = Bool Bool
   | W8  Int Word8
@@ -387,6 +402,7 @@ data Primitive
   | W64 Int Word64
   | BS  Int B.ByteString
   | LBS Int L.ByteString
+  | Skip Int
   | IsEmpty
   deriving (Eq, Show)
 
@@ -395,7 +411,7 @@ type Program = [Primitive]
 instance Arbitrary Primitive where
   arbitrary = do
     let gen c = do
-          let (maxBits, _) = (\w -> (bitSize w, c undefined w)) undefined
+          let (maxBits, _) = (\w -> (finiteBitSize w, c undefined w)) undefined
           bits <- choose (0, maxBits)
           n <- choose (0, fromIntegral (2^bits-1))
           return (c bits n)
@@ -405,6 +421,7 @@ instance Arbitrary Primitive where
       , gen W16
       , gen W32
       , gen W64
+      , Skip <$> choose (0, 3000)
       , do n <- choose (0,10)
            cs <- vector n
            return (BS n (B.pack cs))
@@ -421,10 +438,19 @@ instance Arbitrary Primitive where
       W16 _ x -> snk W16 x
       W32 _ x -> snk W32 x
       W64 _ x -> snk W64 x
+      Skip x -> Skip <$> shrink x
       BS _ bs -> let ws = B.unpack bs in map (\ws' -> BS (length ws') (B.pack ws')) (shrink ws)
       LBS _ lbs -> let ws = L.unpack lbs in map (\ws' -> LBS (length ws') (L.pack ws')) (shrink ws)
       IsEmpty -> []
 
+instance Arbitrary BitOrder where
+   arbitrary = elements [BB, LB, LL, BL]
+   shrink LL  = [BB,LB,BL]
+   shrink BL  = [BB,LB]
+   shrink LB  = [BB]
+   shrink BB  = []
+
+
 prop_primitive :: Primitive -> Property
 prop_primitive prim = property $
   let p = putPrimitive prim
@@ -446,9 +472,10 @@ putPrimitive p =
   case p of
     Bool b -> putBool b
     W8 n x -> putWord8 n x
-    W16 n x -> putWord16be n x
-    W32 n x -> putWord32be n x
-    W64 n x -> putWord64be n x
+    W16 n x -> putWord16 n x
+    W32 n x -> putWord32 n x
+    W64 n x -> putWord64 n x
+    Skip n  -> skipBits n
     BS _ bs -> putByteString bs
     LBS _ lbs -> mapM_ putByteString (L.toChunks lbs)
     IsEmpty -> return ()
@@ -458,13 +485,25 @@ getPrimitive p =
   case p of
     Bool _ -> Bool <$> getBool
     W8 n _ -> W8 n <$> getWord8 n
-    W16 n _ -> W16 n <$> getWord16be n
-    W32 n _ -> W32 n <$> getWord32be n
-    W64 n _ -> W64 n <$> getWord64be n
+    W16 n _ -> W16 n <$> getWord16 n
+    W32 n _ -> W32 n <$> getWord32 n
+    W64 n _ -> W64 n <$> getWord64 n
+    Skip n  -> skipBits n >> return (Skip n)
     BS n _ -> BS n <$> getByteString n
     LBS n _ -> LBS n <$> getLazyByteString n
     IsEmpty -> isEmpty >> return IsEmpty
 
+getPrimitiveSize :: Primitive -> Int
+getPrimitiveSize p = case p of
+    Bool _  -> 1
+    W8 n _  -> n
+    W16 n _ -> n
+    W32 n _ -> n
+    W64 n _ -> n
+    Skip n  -> n
+    BS n _  -> n*8
+    LBS n _ -> n*8
+    IsEmpty -> 0
 
 verifyProgram :: Int -> Program -> BitGet Bool
 verifyProgram totalLength ps0 = go 0 ps0
@@ -472,13 +511,6 @@ verifyProgram totalLength ps0 = go 0 ps0
     go _ [] = return True
     go pos (p:ps) =
       case p of
-        Bool x -> check x getBool >> go (pos+1) ps
-        W8 n x ->  check x (getWord8 n) >> go (pos+n) ps
-        W16 n x -> check x (getWord16be n) >> go (pos+n) ps
-        W32 n x -> check x (getWord32be n) >> go (pos+n) ps
-        W64 n x -> check x (getWord64be n) >> go (pos+n) ps
-        BS n x -> check x (getByteString n) >> go (pos+(8*n)) ps
-        LBS n x -> check x (getLazyByteString n) >> go (pos+(8*n)) ps
         IsEmpty -> do
           let expected = pos == totalLength
           actual <- isEmpty
@@ -486,6 +518,7 @@ verifyProgram totalLength ps0 = go 0 ps0
             then go pos ps
             else error $ "isEmpty returned wrong value, expected "
                           ++ show expected ++ " but got " ++ show actual
+        _ -> check p (getPrimitive p) >> go (pos + getPrimitiveSize p) ps
     check x g = do
       y <- g
       if x == y
diff --git a/Data/Binary/Bits.hs b/Data/Binary/Bits.hs
index 3198d57..02b4404 100644
--- a/Data/Binary/Bits.hs
+++ b/Data/Binary/Bits.hs
@@ -33,13 +33,13 @@ instance BinaryBit Word8 where
   getBits = getWord8
 
 instance BinaryBit Word16 where
-  putBits = putWord16be
-  getBits = getWord16be
+  putBits = putWord16
+  getBits = getWord16
 
 instance BinaryBit Word32 where
-  putBits = putWord32be
-  getBits = getWord32be
+  putBits = putWord32
+  getBits = getWord32
 
 instance BinaryBit Word64 where
-  putBits = putWord64be
-  getBits = getWord64be
+  putBits = putWord64
+  getBits = getWord64
diff --git a/Data/Binary/Bits/Alignment.hs b/Data/Binary/Bits/Alignment.hs
new file mode 100644
index 0000000..2cd1178
--- /dev/null
+++ b/Data/Binary/Bits/Alignment.hs
@@ -0,0 +1,22 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Binary.Bits.Get
+-- Copyright   :  (c) Lennart Kolmodin 2010-2011
+--                (c) Sylvain Henry 2015
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  kolmodin@gmail.com
+-- Stability   :  experimental
+-- Portability :  portable (should run where the package binary runs)
+
+module Data.Binary.Bits.Alignment
+   ( Alignable(..)
+   )
+where
+
+class Monad m => Alignable m where
+   -- | Skip the given number of bits
+   skipBits :: Int -> m ()
+
+   -- | Skip bits if necessary to align to the next byte
+   alignByte :: m ()
diff --git a/Data/Binary/Bits/BitOrder.hs b/Data/Binary/Bits/BitOrder.hs
new file mode 100644
index 0000000..40299b9
--- /dev/null
+++ b/Data/Binary/Bits/BitOrder.hs
@@ -0,0 +1,47 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Binary.Bits.Get
+-- Copyright   :  (c) Lennart Kolmodin 2010-2011
+--                (c) Sylvain Henry 2015
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  kolmodin@gmail.com
+-- Stability   :  experimental
+-- Portability :  portable (should run where the package binary runs)
+
+module Data.Binary.Bits.BitOrder
+   ( BitOrder(..)
+   , BitOrderable(..)
+   )
+where
+
+-- | Bit order
+--
+-- E.g. two words of 5 bits: ABCDE, VWXYZ
+--    - BB: ABCDEVWX YZxxxxxx
+--    - LL: XYZABCDE xxxxxxVW
+--    - BL: EDCBAZYX WVxxxxxx
+--    - LB: XWVEDCBA xxxxxxZY
+data BitOrder
+   = BB  -- ^ Big-endian bytes and bits
+   | LB  -- ^ Little-endian bytes, big-endian bits
+   | BL  -- ^ Big-endian bytes, little-endian bits
+   | LL  -- ^ Little-endian bytes and bits
+   deriving (Show)
+
+
+class Monad m => BitOrderable m where
+   -- | Set the current bit-order
+   setBitOrder :: BitOrder -> m ()
+
+   -- | Retrieve the current bit-order
+   getBitOrder    :: m BitOrder
+
+   -- | Perform the given action with the given bit-order
+   withBitOrder   :: BitOrder -> m a -> m a
+   withBitOrder bo act = do
+      bo' <- getBitOrder
+      setBitOrder bo
+      r <- act
+      setBitOrder bo'
+      return r
diff --git a/Data/Binary/Bits/Get.hs b/Data/Binary/Bits/Get.hs
index 7d910ac..1f7fc47 100644
--- a/Data/Binary/Bits/Get.hs
+++ b/Data/Binary/Bits/Get.hs
@@ -4,6 +4,7 @@
 -- |
 -- Module      :  Data.Binary.Bits.Get
 -- Copyright   :  (c) Lennart Kolmodin 2010-2011
+--                (c) Sylvain Henry 2015
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  kolmodin@gmail.com
@@ -60,10 +61,17 @@ module Data.Binary.Bits.Get
             -- ** Get bytes
             , getBool
             , getWord8
+            , getWord16
+            , getWord32
+            , getWord64
             , getWord16be
             , getWord32be
             , getWord64be
 
+            -- ** Skip bits
+            , skipBits
+            , alignByte
+
             -- * Blocks
 
             -- $blocks
@@ -73,6 +81,9 @@ module Data.Binary.Bits.Get
             -- ** Read in Blocks
             , bool
             , word8
+            , word16
+            , word32
+            , word64
             , word16be
             , word32be
             , word64be
@@ -83,25 +94,27 @@ module Data.Binary.Bits.Get
 
             ) where
 
-import Data.Binary.Get as B ( runGet, Get, getByteString, getLazyByteString, isEmpty )
+import Data.Binary.Get as B ( Get, getLazyByteString, isEmpty )
 import Data.Binary.Get.Internal as B ( get, put, ensureN )
+import Data.Binary.Bits.BitOrder
+import Data.Binary.Bits.Internal
+import Data.Binary.Bits.Alignment
 
 import Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Data.ByteString.Unsafe
+import Foreign.Marshal.Alloc (mallocBytes)
+import Foreign.Ptr
+import Foreign.Storable (poke)
+import System.IO.Unsafe (unsafePerformIO)
 
 import Data.Bits
 import Data.Word
 import Control.Applicative
+import Control.Monad (when,foldM_)
 
 import Prelude as P
 
-#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
-import GHC.Base
-import GHC.Word
-#endif
-
-
 -- $bitget
 -- Parse bits using a monad.
 --
@@ -149,191 +162,108 @@ import GHC.Word
 -- @
 
 data S = S {-# UNPACK #-} !ByteString -- Input
-           {-# UNPACK #-} !Int -- Bit offset (0-7)
+           {-# UNPACK #-} !Int        -- Bit offset (0-7)
+                          !BitOrder   -- Bit order
           deriving (Show)
 
--- | A block that will be read with only one boundry check. Needs to know the
--- number of bits in advance.
-data Block a = Block Int (S -> a)
-
-instance Functor Block where
-  fmap f (Block i p) = Block i (\s -> f (p s))
-
-instance Applicative Block where
-  pure a = Block 0 (\_ -> a)
-  (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
-  (Block i _)  *> (Block j q) = Block (i+j) (q . incS i)
-  (Block i p) <*  (Block j _) = Block (i+j) p
-
--- | Get a block. Will be read with one single boundry check, and
--- therefore requires a statically known number of bits.
--- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
--- 'byteString' and 'Applicative'.
-block :: Block a -> BitGet a
-block (Block i p) = do
-  ensureBits i
-  s <- getState
-  putState $! (incS i s)
-  return $! p s
-
+-- | Increment the current bit offset
 incS :: Int -> S -> S
-incS o (S bs n) =
-  let !o' = (n+o)
-      !d = o' `shiftR` 3
-      !n' = o' .&. make_mask 3
-  in S (unsafeDrop d bs) n'
-
--- | make_mask 3 = 00000111
-make_mask :: (Bits a, Num a) => Int -> a
-make_mask n = (1 `shiftL` fromIntegral n) - 1
-{-# SPECIALIZE make_mask :: Int -> Int #-}
-{-# SPECIALIZE make_mask :: Int -> Word #-}
-{-# SPECIALIZE make_mask :: Int -> Word8 #-}
-{-# SPECIALIZE make_mask :: Int -> Word16 #-}
-{-# SPECIALIZE make_mask :: Int -> Word32 #-}
-{-# SPECIALIZE make_mask :: Int -> Word64 #-}
-
-bit_offset :: Int -> Int
-bit_offset n = make_mask 3 .&. n
-
-byte_offset :: Int -> Int
-byte_offset n = n `shiftR` 3
+incS o (S bs n bo) = S (unsafeDrop d bs) n' bo
+   where
+      !o' = (n+o)
+      !d  = byte_offset o'
+      !n' = bit_offset o'
 
+-- | Read a single bit
 readBool :: S -> Bool
-readBool (S bs n) = testBit (unsafeHead bs) (7-n)
-
-{-# INLINE readWord8 #-}
-readWord8 :: Int -> S -> Word8
-readWord8 n (S bs o)
-  -- no bits at all, return 0
-  | n == 0 = 0
-
-  -- all bits are in the same byte
-  -- we just need to shift and mask them right
-  | n <= 8 - o = let w = unsafeHead bs
-                     m = make_mask n
-                     w' = (w `shiftr_w8` (8 - o - n)) .&. m
-                 in w'
-
-  -- the bits are in two different bytes
-  -- make a word16 using both bytes, and then shift and mask
-  | n <= 8 = let w = (fromIntegral (unsafeHead bs) `shiftl_w16` 8) .|.
-                     (fromIntegral (unsafeIndex bs 1))
-                 m = make_mask n
-                 w' = (w `shiftr_w16` (16 - o - n)) .&. m
-             in fromIntegral w'
-
-{-# INLINE readWord16be #-}
-readWord16be :: Int -> S -> Word16
-readWord16be n s@(S bs o)
-
-  -- 8 or fewer bits, use readWord8
-  | n <= 8 = fromIntegral (readWord8 n s)
-
-  -- handle 9 or more bits, stored in two bytes
-
-  -- no offset, plain and simple 16 bytes
-  | o == 0 && n == 16 = let msb = fromIntegral (unsafeHead bs)
-                            lsb = fromIntegral (unsafeIndex bs 1)
-                            w = (msb `shiftl_w16` 8) .|. lsb
-                        in w
-
-  -- no offset, but not full 16 bytes
-  | o == 0 = let msb = fromIntegral (unsafeHead bs)
-                 lsb = fromIntegral (unsafeIndex bs 1)
-                 w = (msb `shiftl_w16` (n-8)) .|. (lsb `shiftr_w16` (16-n))
-             in w
-
-  -- with offset, and n=9-16
-  | n <= 16 = readWithOffset s shiftl_w16 shiftr_w16 n
-
-  | otherwise = error "readWord16be: tried to read more than 16 bits"
-
-{-# INLINE readWord32be #-}
-readWord32be :: Int -> S -> Word32
-readWord32be n s@(S _ o)
-  -- 8 or fewer bits, use readWord8
-  | n <= 8 = fromIntegral (readWord8 n s)
-
-  -- 16 or fewer bits, use readWord16be
-  | n <= 16 = fromIntegral (readWord16be n s)
-
-  | o == 0 = readWithoutOffset s shiftl_w32 shiftr_w32 n
-
-  | n <= 32 = readWithOffset s shiftl_w32 shiftr_w32 n
-
-  | otherwise = error "readWord32be: tried to read more than 32 bits"
-
-
-{-# INLINE readWord64be #-}
-readWord64be :: Int -> S -> Word64
-readWord64be n s@(S _ o)
-  -- 8 or fewer bits, use readWord8
-  | n <= 8 = fromIntegral (readWord8 n s)
-
-  -- 16 or fewer bits, use readWord16be
-  | n <= 16 = fromIntegral (readWord16be n s)
-
-  | o == 0 = readWithoutOffset s shiftl_w64 shiftr_w64 n
-
-  | n <= 64 = readWithOffset s shiftl_w64 shiftr_w64 n
-
-  | otherwise = error "readWord64be: tried to read more than 64 bits"
-
+readBool (S bs o bo) = case bo of
+   BB -> testBit (unsafeHead bs) (7-o)
+   BL -> testBit (unsafeHead bs) (7-o)
+   LL -> testBit (unsafeHead bs) o
+   LB -> testBit (unsafeHead bs) o
 
+-- | Extract a range of bits from (ws :: ByteString)
+--
+-- Constraint: 8 * (length ws -1 ) < o+n <= 8 * length ws
+extract :: (Num a, FastBits a) => BitOrder -> ByteString -> Int -> Int -> a
+extract bo bs o n     
+   | n == 0            = 0
+   | B.length bs == 0  = error "Empty ByteString"
+   | otherwise         = rev . mask n . foldlWithIndex' f 0 $ bs
+   where 
+      -- B.foldl' with index
+      foldlWithIndex' op b = fst . B.foldl' g (b,0)
+         where g (b',i) w = (op b' w i, (i+1))
+
+      -- 'or' correctly shifted words
+      f b w i = b .|. (fromIntegral w `fastShift` off i)
+
+      -- co-offset
+      r = B.length bs * 8 - (o + n)
+
+      -- shift offset depending on the byte position (0..B.length-1)
+      off i = case bo of
+         LL -> 8*i - o
+         LB -> 8*i - o
+         BB -> (B.length bs -1 - i) * 8 - r
+         BL -> (B.length bs -1 - i) * 8 - r
+
+      -- reverse bits if necessary
+      rev = case bo of
+         LB -> reverseBits n
+         BL -> reverseBits n
+         BB -> id
+         LL -> id
+
+
+-- | Generic readWord
+readWord :: (Num a, FastBits a) => Int -> S -> a
+readWord n (S bs o bo)
+   | n == 0    = 0
+   | otherwise = extract bo (unsafeTake nbytes bs) o n
+   where nbytes = byte_offset (o+n+7)
+
+-- | Check that the number of bits to read is not greater than the first parameter
+{-# INLINE readWordChecked #-}
+readWordChecked :: (Num a, FastBits a) => Int -> Int -> S -> a
+readWordChecked m n s
+   | n > m     = error $ "Tried to read more than " ++ show m ++ " bits (" ++ show n ++")"
+   | otherwise = readWord n s
+
+-- | Read the given number of bytes and return them in Big-Endian order
+--
+-- Examples:
+--    BB: xxxABCDE FGHIJKLM NOPxxxxx -> ABCDEFGH IJKLMNOP
+--    LL: LMNOPxxx DEFGHIJK xxxxxABC -> ABCDEFGH IJKLMNOP
+--    BL: xxxPONML KJIHGFED CBAxxxxx -> ABCDEFGH IJKLMNOP
+--    LB: EDCBAxxx MLKJIHGF xxxxxPON -> ABCDEFGH IJKLMNOP
 readByteString :: Int -> S -> ByteString
-readByteString n s@(S bs o)
-  -- no offset, easy.
-  | o == 0 = unsafeTake n bs
-  -- offset. ugg. this is really naive and slow. but also pretty easy :)
-  | otherwise = B.pack (P.map (readWord8 8) (P.take n (iterate (incS 8) s)))
-
-readWithoutOffset :: (Bits a, Num a)
-                  => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
-readWithoutOffset (S bs o) shifterL shifterR n
-  | o /= 0 = error "readWithoutOffset: there is an offset"
-
-  | bit_offset n == 0 && byte_offset n <= 4 = 
-              let segs = byte_offset n
-                  bn 0 = fromIntegral (unsafeHead bs)
-                  bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
-
-              in bn (segs-1)
-
-  | n <= 64 = let segs = byte_offset n
-                  o' = bit_offset (n - 8 + o)
-
-                  bn 0 = fromIntegral (unsafeHead bs)
-                  bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
+readByteString n (S bs o bo) =
+   let 
+      bs'  = unsafeTake (n+1) bs
+      bs'' = unsafeTake n bs
+      rev  = B.map (reverseBits 8)
+   in case (o,bo) of
+      (0,BB) -> bs''
+      (0,LL) -> B.reverse bs''
+      (0,LB) -> rev bs''
+      (0,BL) -> rev . B.reverse $ bs''
+      (_,LL) -> readByteString n (S (B.reverse bs') (8-o) BB)
+      (_,BL) -> rev . B.reverse $ readByteString n (S bs' o BB)
+      (_,LB) -> rev . B.reverse $ readByteString n (S bs' o LL)
+      (_,BB) -> unsafePerformIO $ do
+         let len = n+1
+         ptr <- mallocBytes len
+         let f r i = do
+               let
+                  w  = unsafeIndex bs (len-i)
+                  w' = (w `fastShiftL` o) .|. r
+                  r' = w `fastShiftR` (8-o)
+               poke (ptr `plusPtr` (len-i)) w'
+               return r'
+         foldM_ f 0 [1..len]
+         unsafeInit <$> unsafePackMallocCStringLen (ptr,len)
 
-                  msegs = bn (segs-1) `shifterL` o'
-
-                  last = (fromIntegral (unsafeIndex bs segs)) `shifterR` (8 - o')
-
-                  w = msegs .|. last
-              in w
-
-readWithOffset :: (Bits a, Num a)
-         => S -> (a -> Int -> a) -> (a -> Int -> a) -> Int -> a
-readWithOffset (S bs o) shifterL shifterR n
-  | n <= 64 = let bits_in_msb = 8 - o
-                  (n',top) = (n - bits_in_msb
-                             , (fromIntegral (unsafeHead bs) .&. make_mask bits_in_msb) `shifterL` n')
-                    
-                  segs = byte_offset n'
-
-                  bn 0 = 0
-                  bn n = (bn (n-1) `shifterL` 8) .|. fromIntegral (unsafeIndex bs n)
-
-                  o' = bit_offset n'
-
-                  mseg = bn segs `shifterL` o'
-
-                  last | o' > 0 = (fromIntegral (unsafeIndex bs (segs + 1))) `shifterR` (8 - o')
-                       | otherwise = 0
-
-                  w = top .|. mseg .|. last
-              in w
 
 ------------------------------------------------------------------------
 -- | 'BitGet' is a monad, applicative and a functor. See 'runBitGet'
@@ -342,7 +272,7 @@ newtype BitGet a = B { runState :: S -> Get (S,a) }
 
 instance Monad BitGet where
   return x = B $ \s -> return (s,x)
-  fail str = B $ \(S inp n) -> putBackState inp n >> fail str
+  fail str = B $ \s -> putBackState s >> fail str
   (B f) >>= g = B $ \s -> do (s',a) <- f s
                              runState (g a) s'
 
@@ -353,25 +283,51 @@ instance Applicative BitGet where
   pure x = return x
   fm <*> m = fm >>= \f -> m >>= \v -> return (f v)
 
+instance BitOrderable BitGet where
+   setBitOrder bo = do
+      (S bs o _) <- getState
+      putState (S bs o bo)
+
+   getBitOrder = do
+      (S _ _ bo) <- getState
+      return bo
+
+instance Alignable BitGet where
+   -- | Skip the given number of bits
+   skipBits n = do
+      ensureBits n
+      withState (incS n)
+
+   -- | Skip bits if necessary to align to the next byte
+   alignByte = do
+      (S _ o _) <- getState
+      when (o /= 0) $
+         skipBits (8-o)
+
+
+
 -- | Run a 'BitGet' within the Binary packages 'Get' monad. If a byte has
 -- been partially consumed it will be discarded once 'runBitGet' is finished.
 runBitGet :: BitGet a -> Get a
 runBitGet bg = do
   s <- mkInitState
-  ((S str' n),a) <- runState bg s
-  putBackState str' n
+  (s',a) <- runState bg s
+  putBackState s'
   return a
 
 mkInitState :: Get S
 mkInitState = do
-  str <- get
+  bs <- get
   put B.empty
-  return (S str 0)
+  return (S bs 0 BB)
 
-putBackState :: B.ByteString -> Int -> Get ()
-putBackState bs n = do
+putBackState :: S -> Get ()
+putBackState (S bs o _) = do
  remaining <- get
- put (B.drop (if n==0 then 0 else 1) bs `B.append` remaining)
+ let bs' = case o of
+      0 -> bs
+      _ -> unsafeDrop 1 bs
+ put (bs' `B.append` remaining)
 
 getState :: BitGet S
 getState = B $ \s -> return (s,s)
@@ -379,18 +335,30 @@ getState = B $ \s -> return (s,s)
 putState :: S -> BitGet ()
 putState s = B $ \_ -> return (s,())
 
+withState :: (S -> S) -> BitGet ()
+withState f = do
+   s <- getState
+   putState $! f s
+
 -- | Make sure there are at least @n@ bits.
 ensureBits :: Int -> BitGet ()
 ensureBits n = do
-  (S bs o) <- getState
+  (S bs o bo) <- getState
   if n <= (B.length bs * 8 - o)
     then return ()
     else do let currentBits = B.length bs * 8 - o
-            let byteCount = (n - currentBits + 7) `div` 8
+            let byteCount   = byte_offset (n - currentBits + 7)
             B $ \_ -> do B.ensureN byteCount
                          bs' <- B.get
                          put B.empty
-                         return (S (bs`append`bs') o, ())
+                         return (S (bs`append`bs') o bo, ())
+
+-- | Test whether all input has been consumed, i.e. there are no remaining
+-- undecoded bytes.
+isEmpty :: BitGet Bool
+isEmpty = B $ \ (S bs o bo) -> if B.null bs
+                               then B.isEmpty >>= \e -> return (S bs o bo, e)
+                               else return (S bs o bo, False)
 
 -- | Get 1 bit as a 'Bool'.
 getBool :: BitGet Bool
@@ -401,16 +369,28 @@ getWord8 :: Int -> BitGet Word8
 getWord8 n = block (word8 n)
 
 -- | Get @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
+getWord16 :: Int -> BitGet Word16
+getWord16 n = block (word16 n)
+
 getWord16be :: Int -> BitGet Word16
-getWord16be n = block (word16be n)
+getWord16be = getWord16
+{-# DEPRECATED getWord16be "Use 'getWord16' instead" #-}
 
 -- | Get @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
+getWord32 :: Int -> BitGet Word32
+getWord32 n = block (word32 n)
+
 getWord32be :: Int -> BitGet Word32
-getWord32be n = block (word32be n)
+getWord32be = getWord32
+{-# DEPRECATED getWord32be "Use 'getWord32' instead" #-}
 
 -- | Get @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
+getWord64 :: Int -> BitGet Word64
+getWord64 n = block (word64 n)
+
 getWord64be :: Int -> BitGet Word64
-getWord64be n = block (word64be n)
+getWord64be = getWord64
+{-# DEPRECATED getWord64be "Use 'getWord64' instead" #-}
 
 -- | Get @n@ bytes as a 'ByteString'.
 getByteString :: Int -> BitGet ByteString
@@ -419,20 +399,41 @@ getByteString n = block (byteString n)
 -- | Get @n@ bytes as a lazy ByteString.
 getLazyByteString :: Int -> BitGet L.ByteString
 getLazyByteString n = do
-  (S _ o) <- getState
+  (S _ o bo) <- getState
   case o of
-    0 -> B $ \ (S bs o') -> do
-            putBackState bs o'
+    0 -> B $ \s -> do
+            putBackState s
             lbs <- B.getLazyByteString (fromIntegral n)
-            return (S B.empty 0, lbs)
+            return (S B.empty 0 bo, lbs)
     _ -> L.fromChunks . (:[]) <$> Data.Binary.Bits.Get.getByteString n
 
--- | Test whether all input has been consumed, i.e. there are no remaining
--- undecoded bytes.
-isEmpty :: BitGet Bool
-isEmpty = B $ \ (S bs o) -> if B.null bs
-                               then B.isEmpty >>= \e -> return (S bs o, e)
-                               else return (S bs o, False)
+
+
+
+
+-- | A block that will be read with only one boundary check. Needs to know the
+-- number of bits in advance.
+data Block a = Block Int (S -> a)
+
+instance Functor Block where
+  fmap f (Block i p) = Block i (\s -> f (p s))
+
+instance Applicative Block where
+  pure a = Block 0 (\_ -> a)
+  (Block i p) <*> (Block j q) = Block (i+j) (\s -> p s $ q (incS i s))
+  (Block i _)  *> (Block j q) = Block (i+j) (q . incS i)
+  (Block i p) <*  (Block j _) = Block (i+j) p
+
+-- | Get a block. Will be read with one single boundry check, and
+-- therefore requires a statically known number of bits.
+-- Build blocks using 'bool', 'word8', 'word16be', 'word32be', 'word64be',
+-- 'byteString' and 'Applicative'.
+block :: Block a -> BitGet a
+block (Block i p) = do
+  ensureBits i
+  s <- getState
+  putState $! (incS i s)
+  return $! p s
 
 -- | Read a 1 bit 'Bool'.
 bool :: Block Bool
@@ -440,67 +441,34 @@ bool = Block 1 readBool
 
 -- | Read @n@ bits as a 'Word8'. @n@ must be within @[0..8]@.
 word8 :: Int -> Block Word8
-word8 n = Block n (readWord8 n)
+word8 n = Block n (readWordChecked 8 n)
 
 -- | Read @n@ bits as a 'Word16'. @n@ must be within @[0..16]@.
+word16 :: Int -> Block Word16
+word16 n = Block n (readWordChecked 16 n)
+
 word16be :: Int -> Block Word16
-word16be n = Block n (readWord16be n)
+word16be = word16
+{-# DEPRECATED word16be "Use 'word16' instead" #-}
 
 -- | Read @n@ bits as a 'Word32'. @n@ must be within @[0..32]@.
+word32 :: Int -> Block Word32
+word32 n = Block n (readWordChecked 32 n)
+
 word32be :: Int -> Block Word32
-word32be n = Block n (readWord32be n)
+word32be = word32
+{-# DEPRECATED word32be "Use 'word32' instead" #-}
 
 -- | Read @n@ bits as a 'Word64'. @n@ must be within @[0..64]@.
+word64 :: Int -> Block Word64
+word64 n = Block n (readWordChecked 64 n)
+
 word64be :: Int -> Block Word64
-word64be n = Block n (readWord64be n)
+word64be = word64
+{-# DEPRECATED word64be "Use 'word64' instead" #-}
 
 -- | Read @n@ bytes as a 'ByteString'.
 byteString :: Int -> Block ByteString
 byteString n | n > 0 = Block (n*8) (readByteString n)
              | otherwise = Block 0 (\_ -> B.empty)
 
-------------------------------------------------------------------------
--- Unchecked shifts, from the package binary
-
-shiftl_w16 :: Word16 -> Int -> Word16
-shiftl_w32 :: Word32 -> Int -> Word32
-shiftl_w64 :: Word64 -> Int -> Word64
-
-#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
-shiftl_w8  (W8#  w) (I# i) = W8# (w `uncheckedShiftL#`   i)
-shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#`   i)
-shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)
-
-shiftr_w8  (W8#  w) (I# i) = W8# (w `uncheckedShiftRL#`   i)
-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`  i)
-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`  i)
-
-
-#if WORD_SIZE_IN_BITS < 64
-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#`  i)
-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
-
-#if __GLASGOW_HASKELL__ <= 606
--- Exported by GHC.Word in GHC 6.8 and higher
-foreign import ccall unsafe "stg_uncheckedShiftL64"
-    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#
-foreign import ccall unsafe "stg_uncheckedShiftRL64"
-    uncheckedShiftRL64#     :: Word64# -> Int# -> Word64#
-#endif
-
-#else
-shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#`  i)
-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
-#endif
-
-#else
-shiftl_w8 = shiftL
-shiftl_w16 = shiftL
-shiftl_w32 = shiftL
-shiftl_w64 = shiftL
-
-shiftr_w8 = shiftR
-shiftr_w16 = shiftR
-shiftr_w32 = shiftR
-shiftr_w64 = shiftR
-#endif
diff --git a/Data/Binary/Bits/Internal.hs b/Data/Binary/Bits/Internal.hs
new file mode 100644
index 0000000..5869a89
--- /dev/null
+++ b/Data/Binary/Bits/Internal.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE RankNTypes, MagicHash, BangPatterns, CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Binary.Bits.Get
+-- Copyright   :  (c) Lennart Kolmodin 2010-2011
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  kolmodin@gmail.com
+-- Stability   :  experimental
+-- Portability :  portable (should run where the package binary runs)
+
+module Data.Binary.Bits.Internal
+   ( make_mask
+   , mask
+   , bit_offset
+   , byte_offset
+   , reverseBits
+   , FastBits(..)
+   )
+where
+
+import Data.Word
+import Data.Bits
+
+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
+import GHC.Base
+import GHC.Word
+#endif
+
+-- | make_mask 3 = 00000111
+make_mask :: (Bits a, Num a) => Int -> a
+make_mask n = (1 `shiftL` fromIntegral n) - 1
+{-# SPECIALIZE make_mask :: Int -> Int #-}
+{-# SPECIALIZE make_mask :: Int -> Word #-}
+{-# SPECIALIZE make_mask :: Int -> Word8 #-}
+{-# SPECIALIZE make_mask :: Int -> Word16 #-}
+{-# SPECIALIZE make_mask :: Int -> Word32 #-}
+{-# SPECIALIZE make_mask :: Int -> Word64 #-}
+
+-- | Keep only the n least-significant bits of the given value
+mask :: (Bits a, Num a) => Int -> a -> a
+mask n v = v .&. make_mask n
+{-# INLINE mask #-}
+
+-- | Compute bit offset (equivalent to x `mod` 8 but faster)
+bit_offset :: Int -> Int
+bit_offset n = make_mask 3 .&. n
+{-# INLINE bit_offset #-}
+
+-- | Compute byte offset (equivalent to x `div` 8 but faster)
+byte_offset :: Int -> Int
+byte_offset n = n `shiftR` 3
+{-# INLINE byte_offset #-}
+
+-- | Reverse the @n@ least important bits of the given value
+reverseBits :: (Num a, FastBits a, Bits a) => Int -> a -> a
+reverseBits n value = rec value n 0
+   where
+      -- rec v i r, where
+      --    v is orginal value shifted
+      --    i is the remaining number of bits
+      --    r is current value
+      rec 0 0 r = r
+      rec 0 i r = r `fastShiftL` i
+      rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))
+
+
+---------------------------------------------------------------------
+-- Unchecked shifts, from the "binary" package
+
+-- | Class for types supporting fast bit shifting
+class Bits a => FastBits a where
+   fastShiftR :: a -> Int -> a
+   fastShiftR = shiftR
+
+   fastShiftL :: a -> Int -> a
+   fastShiftL = shiftL
+
+   {-# INLINE fastShift #-}
+   fastShift :: a -> Int -> a
+   fastShift x n
+      | n > 0 = fastShiftL x n
+      | n < 0 = fastShiftR x (negate n)
+      | otherwise = x
+
+instance FastBits Word8 where
+   fastShiftR = shiftr_w8
+   fastShiftL = shiftl_w8
+
+instance FastBits Word16 where
+   fastShiftR = shiftr_w16
+   fastShiftL = shiftl_w16
+
+instance FastBits Word32 where
+   fastShiftR = shiftr_w32
+   fastShiftL = shiftl_w32
+
+instance FastBits Word64 where
+   fastShiftR = shiftr_w64
+   fastShiftL = shiftl_w64
+
+instance FastBits Int
+
+instance FastBits Word
+
+
+shiftl_w8  :: Word8  -> Int -> Word8
+shiftl_w16 :: Word16 -> Int -> Word16
+shiftl_w32 :: Word32 -> Int -> Word32
+shiftl_w64 :: Word64 -> Int -> Word64
+
+shiftr_w8  :: Word8  -> Int -> Word8
+shiftr_w16 :: Word16 -> Int -> Word16
+shiftr_w32 :: Word32 -> Int -> Word32
+shiftr_w64 :: Word64 -> Int -> Word64
+
+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
+shiftl_w8  (W8# w)  (I# i) = W8#  (w `uncheckedShiftL#`   i)
+shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#`   i)
+shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)
+
+shiftr_w8  (W8#  w) (I# i) = W8# (w `uncheckedShiftRL#`   i)
+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`  i)
+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`  i)
+
+
+#if WORD_SIZE_IN_BITS < 64
+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#`  i)
+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
+
+#if __GLASGOW_HASKELL__ <= 606
+-- Exported by GHC.Word in GHC 6.8 and higher
+foreign import ccall unsafe "stg_uncheckedShiftL64"
+    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#
+foreign import ccall unsafe "stg_uncheckedShiftRL64"
+    uncheckedShiftRL64#     :: Word64# -> Int# -> Word64#
+#endif
+
+#else
+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#`  i)
+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
+#endif
+
+#else
+shiftl_w8  = shiftL
+shiftl_w16 = shiftL
+shiftl_w32 = shiftL
+shiftl_w64 = shiftL
+
+shiftr_w8 = shiftR
+shiftr_w16 = shiftR
+shiftr_w32 = shiftR
+shiftr_w64 = shiftR
+#endif
diff --git a/Data/Binary/Bits/Put.hs b/Data/Binary/Bits/Put.hs
index b1e9e1f..269eb66 100644
--- a/Data/Binary/Bits/Put.hs
+++ b/Data/Binary/Bits/Put.hs
@@ -2,6 +2,7 @@
 -- |
 -- Module      :  Data.Binary.Bits.Put
 -- Copyright   :  (c) Lennart Kolmodin 2010-2011
+--                (c) Sylvain Henry 2015
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  kolmodin@gmail.com
@@ -22,6 +23,9 @@ module Data.Binary.Bits.Put
 
           -- ** Words
           , putWord8
+          , putWord16
+          , putWord32
+          , putWord64
           , putWord16be
           , putWord32be
           , putWord64be
@@ -35,10 +39,15 @@ import qualified Data.Binary.Builder as B
 import Data.Binary.Builder ( Builder )
 import qualified Data.Binary.Put as Put
 import Data.Binary.Put ( Put )
+import Data.Binary.Bits.Internal
+import Data.Binary.Bits.BitOrder
+import Data.Binary.Bits.Alignment
 
-import Data.ByteString
+import Data.ByteString as BS
+import Data.ByteString.Unsafe as BS
 
 import Control.Applicative
+import Control.Monad (when)
 import Data.Bits
 import Data.Monoid
 import Data.Word
@@ -47,113 +56,139 @@ data BitPut a = BitPut { run :: (S -> PairS a) }
 
 data PairS a = PairS a {-# UNPACK #-} !S
 
-data S = S !Builder !Word8 !Int
+data S = S !Builder !Word8 !Int !BitOrder
 
 -- | Put a 1 bit 'Bool'.
 putBool :: Bool -> BitPut ()
 putBool b = putWord8 1 (if b then 0xff else 0x00)
 
--- | make_mask 3 = 00000111
-make_mask :: (Bits a, Num a) => Int -> a
-make_mask n = (1 `shiftL` fromIntegral n) - 1
-{-# SPECIALIZE make_mask :: Int -> Int #-}
-{-# SPECIALIZE make_mask :: Int -> Word #-}
-{-# SPECIALIZE make_mask :: Int -> Word8 #-}
-{-# SPECIALIZE make_mask :: Int -> Word16 #-}
-{-# SPECIALIZE make_mask :: Int -> Word32 #-}
-{-# SPECIALIZE make_mask :: Int -> Word64 #-}
+
+-- | Generic putWord
+putWord :: (Num a, FastBits a, Integral a) => Int -> a -> BitPut ()
+putWord n w = BitPut $ \s -> PairS () (putWordS n w s)
+
+putWordS :: (Num a, FastBits a, Integral a) => Int -> a -> S -> S
+putWordS n w s@(S builder b o bo) = s'
+   where
+      -- number of bits that will be stored in the current byte
+      cn = min (8-o) n
+
+      -- new state
+      s' = case n of
+            0 -> s
+            _ -> putWordS (n-cn) w' (flush (S builder b' (o+cn) bo))
+      
+      -- new current byte
+      b' = shl (selectBits w) .|. b
+
+      -- Word containing the remaining (n-cn) bits to store in its LSB
+      w' = case bo of
+         BB -> w
+         BL -> w `fastShiftR` cn
+         LL -> w `fastShiftR` cn
+         LB -> w
+
+      -- Select bits to store in the current byte.
+      -- Put them in the correct order and return them in the least-significant
+      -- bits of the returned value
+      selectBits :: (Num a, FastBits a, Integral a) => a -> Word8
+      selectBits x = fromIntegral $ case bo of
+         BB ->                  mask cn $ x `fastShiftR` (n-cn)
+         LB -> reverseBits cn $ mask cn $ x `fastShiftR` (n-cn)
+         LL ->                  mask cn x
+         BL -> reverseBits cn $ mask cn x
+
+      -- shift left at the correct position
+      shl :: Word8 -> Word8
+      shl x = case bo of
+         BB -> x `fastShiftL` (8-o-cn)
+         BL -> x `fastShiftL` (8-o-cn)
+         LL -> x `fastShiftL` o
+         LB -> x `fastShiftL` o
+
+      flush s2@(S b2 w2 o2 bo2)
+        | o2 == 8   = S (b2 `mappend` B.singleton w2) 0 0 bo2
+        | otherwise = s2
+
 
 -- | Put the @n@ lower bits of a 'Word8'.
 putWord8 :: Int -> Word8 -> BitPut ()
-putWord8 n w = BitPut $ \s -> PairS () $
-  let w' = make_mask n .&. w in
-  case s of
-                -- a whole word8, no offset
-    (S b t o) | n == 8 && o == 0 -> flush $ S b w n
-                -- less than a word8, will fit in the current word8
-              | n <= 8 - o       -> flush $ S b (t .|. (w' `shiftL` (8 - n - o))) (o+n)
-                -- will finish this word8, and spill into the next one
-              | otherwise -> flush $
-                              let o' = o + n - 8
-                                  b' = t .|. (w' `shiftR` o')
-                                  t' = w `shiftL` (8 - o')
-                              in S (b `mappend` B.singleton b') t' o'
+putWord8 = putWord
 
 -- | Put the @n@ lower bits of a 'Word16'.
+putWord16 :: Int -> Word16 -> BitPut ()
+putWord16 = putWord
+
 putWord16be :: Int -> Word16 -> BitPut ()
-putWord16be n w
-  | n <= 8 = putWord8 n (fromIntegral w)
-  | otherwise =
-      BitPut $ \s -> PairS () $
-        let w' = make_mask n .&. w in
-        case s of
-          -- as n>=9, it's too big to fit into one single byte
-          -- it'll either use 2 or 3 bytes
-                                     -- it'll fit in 2 bytes
-          (S b t o) | o + n <= 16 -> flush $
-                        let o' = o + n - 8
-                            b' = t .|. fromIntegral (w' `shiftR` o')
-                            t' = fromIntegral (w `shiftL` (8-o'))
-                        in (S (b `mappend` B.singleton b') t' o')
-                                   -- 3 bytes required
-                    | otherwise -> flush $
-                        let o'  = o + n - 16
-                            b'  = t .|. fromIntegral (w' `shiftR` (o' + 8))
-                            b'' = fromIntegral ((w `shiftR` o') .&. 0xff)
-                            t'  = fromIntegral (w `shiftL` (8-o'))
-                        in (S (b `mappend` B.singleton b' `mappend` B.singleton b'') t' o')
+putWord16be = putWord
+{-# DEPRECATED putWord16be "Use 'putWord16' instead" #-}
 
 -- | Put the @n@ lower bits of a 'Word32'.
+putWord32 :: Int -> Word32 -> BitPut ()
+putWord32 = putWord
+
 putWord32be :: Int -> Word32 -> BitPut ()
-putWord32be n w
-  | n <= 16 = putWord16be n (fromIntegral w)
-  | otherwise = do
-      putWord32be (n-16) (w`shiftR`16)
-      putWord32be    16  (w .&. 0x0000ffff)
+putWord32be = putWord
+{-# DEPRECATED putWord32be "Use 'putWord32' instead" #-}
 
 -- | Put the @n@ lower bits of a 'Word64'.
+putWord64 :: Int -> Word64 -> BitPut ()
+putWord64 = putWord
+
 putWord64be :: Int -> Word64 -> BitPut ()
-putWord64be n w
-  | n <= 32 = putWord32be n (fromIntegral w)
-  | otherwise = do
-      putWord64be (n-32) (w`shiftR`32)
-      putWord64be    32  (w .&. 0xffffffff)
+putWord64be = putWord
+{-# DEPRECATED putWord64be "Use 'putWord64' instead" #-}
 
 -- | Put a 'ByteString'.
+--
+-- Examples: 3 bits are already written in the current byte
+--    BB: ABCDEFGH IJKLMNOP -> xxxABCDE FGHIJKLM NOPxxxxx
+--    LL: ABCDEFGH IJKLMNOP -> LMNOPxxx DEFGHIJK xxxxxABC
+--    BL: ABCDEFGH IJKLMNOP -> xxxPONML KJIHGFED CBAxxxxx
+--    LB: ABCDEFGH IJKLMNOP -> EDCBAxxx MLKJIHGF xxxxxPON
 putByteString :: ByteString -> BitPut ()
-putByteString bs = do
-  offset <- hasOffset
-  if offset
-    then mapM_ (putWord8 8) (unpack bs) -- naive
-    else joinPut (Put.putByteString bs)
-  where
-    hasOffset = BitPut $ \ s@(S _ _ o) -> PairS (o /= 0) s
+putByteString bs = BitPut $ \s -> PairS () (putByteStringS bs s)
+
+putByteStringS :: ByteString -> S -> S
+putByteStringS bs s
+   | BS.null bs = s
+   | otherwise  = case s of
+      (S builder b 0 BB) -> S (builder `mappend` B.fromByteString bs) b 0 BB
+      (S builder b 0 LL) -> S (builder `mappend` B.fromByteString (BS.reverse bs)) b 0 LL
+      (S builder b 0 LB) -> S (builder `mappend` B.fromByteString (rev bs)) b 0 LB
+      (S builder b 0 BL) -> S (builder `mappend` B.fromByteString (rev (BS.reverse bs))) b 0 BL
+      (S _ _ _ BB)       -> putByteStringS (BS.unsafeTail bs) (putWordS 8 (BS.unsafeHead bs) s)
+      (S _ _ _ LL)       -> putByteStringS (BS.unsafeInit bs) (putWordS 8 (BS.unsafeLast bs) s)
+      (S _ _ _ BL)       -> putByteStringS (BS.unsafeInit bs) (putWordS 8 (BS.unsafeLast bs) s)
+      (S _ _ _ LB)       -> putByteStringS (BS.unsafeTail bs) (putWordS 8 (BS.unsafeHead bs) s)
+   where
+      rev    = BS.map (reverseBits 8)
+
 
 -- | Run a 'Put' inside 'BitPut'. Any partially written bytes will be flushed
 -- before 'Put' executes to ensure byte alignment.
+--
+-- Warning: this method does not take bit order into account (i.e. BB assumed)
 joinPut :: Put -> BitPut ()
 joinPut m = BitPut $ \s0 -> PairS () $
-  let (S b0 _ _) = flushIncomplete s0
+  let (S b0 _ _ bo) = flushIncomplete s0
       b = Put.execPut m
-  in (S (b0`mappend`b) 0 0)
-
-flush :: S -> S
-flush s@(S b w o)
-  | o > 8 = error "flush: offset > 8"
-  | o == 8 = S (b `mappend` B.singleton w) 0 0
-  | otherwise = s
+  in (S (b0`mappend`b) 0 0 bo)
 
 flushIncomplete :: S -> S
-flushIncomplete s@(S b w o)
+flushIncomplete s@(S b w o bo)
   | o == 0 = s
-  | otherwise = (S (b `mappend` B.singleton w) 0 0)
+  | otherwise = (S (b `mappend` B.singleton w) 0 0 bo)
+
+getOffset :: BitPut Int
+getOffset = BitPut $ \s@(S _ _ o _) -> PairS o s
 
 -- | Run the 'BitPut' monad inside 'Put'.
 runBitPut :: BitPut () -> Put.Put
 runBitPut m = Put.putBuilder b
   where
-  PairS _ s = run m (S mempty 0 0)
-  (S b _ _) = flushIncomplete s
+  PairS _ s   = run m (S mempty 0 0 BB)
+  (S b _ _ _) = flushIncomplete s
 
 instance Functor BitPut where
   fmap f (BitPut k) = BitPut $ \s ->
@@ -173,3 +208,20 @@ instance Monad BitPut where
         PairS b s'' = run (k a) s'
     in PairS b s''
   return x = BitPut $ \s -> PairS x s
+
+instance BitOrderable BitPut where
+   setBitOrder bo = BitPut $ \(S bu b o _) -> PairS () (S bu b o bo)
+
+   getBitOrder = BitPut $ \s@(S _ _ _ bo) -> PairS bo s
+
+instance Alignable BitPut where
+   -- | Skip the given number of bits
+   skipBits n
+      | n <= 64   = putWord64 n 0
+      | otherwise = putWord64 64 0 >> skipBits (n-64)
+
+   -- | Skip bits if necessary to align to the next byte
+   alignByte = do
+      o <- getOffset
+      when (o /= 0) $
+         skipBits (8-o)
diff --git a/binary-bits.cabal b/binary-bits.cabal
index 0129675..993c959 100644
--- a/binary-bits.cabal
+++ b/binary-bits.cabal
@@ -1,6 +1,6 @@
 -- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/
 name:                binary-bits
-version:             0.5
+version:             0.6
 synopsis:            Bit parsing/writing on top of binary.
 description:         Bit parsing/writing on top of binary. Provides functions to
                      read and write bits to and from 8\/16\/32\/64 words.
@@ -24,7 +24,10 @@ library
 
   exposed-modules:     Data.Binary.Bits ,
                        Data.Binary.Bits.Put ,
-                       Data.Binary.Bits.Get
+                       Data.Binary.Bits.Get ,
+                       Data.Binary.Bits.BitOrder ,
+                       Data.Binary.Bits.Alignment
+  other-modules:       Data.Binary.Bits.Internal
 
   default-language:    Haskell98
 
@@ -34,6 +37,7 @@ test-suite qc
   type: exitcode-stdio-1.0
   main-is: BitsQC.hs
   default-language:    Haskell98
+  --ghc-options: -O2 -Wall
 
   build-depends: base==4.*, binary >= 0.6.0.0, bytestring,
                  QuickCheck>=2, random,