diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -117,8 +117,8 @@
 For example, consider three possible representations of a set of `Word16`:
 
 * As an `IntSet` with a readily available `union` function.
-* As a 64k long unboxed `Vector Bool`, implementing union as `zipWith (||)`.
-* As a 64k long unboxed `Vector Bit`, implementing union as `zipBits (.|.)`.
+* As a 64k-long unboxed `Vector Bool`, implementing union as `zipWith (||)`.
+* As a 64k-long unboxed `Vector Bit`, implementing union as `zipBits (.|.)`.
 
 In our benchmarks (see `bench` folder) for not-too-sparse sets
 the union of `Vector Bit` evaluates 24x-36x faster than the union of `IntSet`
diff --git a/bench/Bench.hs b/bench/Bench.hs
--- a/bench/Bench.hs
+++ b/bench/Bench.hs
@@ -9,6 +9,7 @@
 import Bench.RandomFlip
 import Bench.RandomRead
 import Bench.RandomWrite
+import Bench.Remainder
 import Bench.Reverse
 import Bench.Sum
 import Bench.Union
@@ -22,6 +23,7 @@
   , bgroup "randomWrite"  $ map benchRandomWrite  [5..14]
   , bgroup "randomFlip"   $ map benchRandomFlip   [5..14]
   , bgroup "randomRead"   $ map benchRandomRead   [5..14]
+  , bgroup "remainder"    $ map benchRemainder    [5..14]
   , bgroup "reverse"      $ map benchReverse      [5..14]
   , bgroup "sum"          $ map benchSum          [5..14]
   , bgroup "union"        $ map benchUnion        [5..14]
diff --git a/bench/Bench/Product.hs b/bench/Bench/Product.hs
--- a/bench/Bench/Product.hs
+++ b/bench/Bench/Product.hs
@@ -27,18 +27,28 @@
   where
     n = 1 `shiftL` k
 
+randomInteger :: Int -> Integer
+randomInteger k = toInteger $ toF2Poly $ randomVec Bit k
+
+randomInteger2 :: Int -> Integer
+randomInteger2 k = toInteger $ toF2Poly $ randomVec2 Bit k
+
 benchProduct :: Int -> Benchmark
 benchProduct k = bgroup (show (1 `shiftL` k :: Int))
-  [ bench "Bit/product"         $ nf (\x -> productBit    (randomVec Bit k) x)    (randomVec2 Bit k)
-  , bench "Bit/productShort"    $ nf (\x -> productBit    (randomVec Bit k) x)    (U.take 32 $ randomVec2 Bit k)
-  , bench "Bit/square"          $ nf (\x -> productBit    (randomVec Bit k) x)    (randomVec Bit k)
-  , bench "Bit.TS/product"      $ nf (\x -> productBitTS  (randomVec TS.Bit k) x) (randomVec2 TS.Bit k)
-  , bench "Bit.TS/productShort" $ nf (\x -> productBitTS  (randomVec TS.Bit k) x) (U.take 32 $ randomVec2 TS.Bit k)
-  , bench "Bit.TS/square"       $ nf (\x -> productBitTS  (randomVec TS.Bit k) x) (randomVec TS.Bit k)
+  [ bench "Bit/product"          $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x)    (toF2Poly $ randomVec2 Bit k)
+  -- , bench "Bit/productShort"     $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x)    (toF2Poly $ U.take 32 $ randomVec2 Bit k)
+  -- , bench "Bit/square"           $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x)    (toF2Poly $ randomVec Bit k)
+  -- , bench "Bit.TS/product"       $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec2 TS.Bit k)
+  -- , bench "Bit.TS/productShort"  $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ U.take 32 $ randomVec2 TS.Bit k)
+  -- , bench "Bit.TS/square"        $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec TS.Bit k)
+  , bench "Integer/product"      $ nf (\x -> binMul (randomInteger k) x) (randomInteger2 k)
+  -- , bench "Integer/productShort" $ nf (\x -> binMul (randomInteger k) x) ((1 `shiftL` 32 - 1) .&. randomInteger2 k)
+  -- , bench "Integer/square"       $ nf (\x -> binMul (randomInteger k) x) (randomInteger k)
   ]
 
-productBit :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
-productBit xs ys = unF2Poly (toF2Poly xs * toF2Poly ys)
-
-productBitTS :: U.Vector TS.Bit -> U.Vector TS.Bit -> U.Vector TS.Bit
-productBitTS xs ys = TS.unF2Poly (TS.toF2Poly xs * TS.toF2Poly ys)
+binMul :: Integer -> Integer -> Integer
+binMul = go 0
+  where
+    go :: Integer -> Integer -> Integer -> Integer
+    go acc _ 0 = acc
+    go acc x y = go (if odd y then acc `xor` x else acc) (x `shiftL` 1) (y `shiftR` 1)
diff --git a/bench/Bench/Remainder.hs b/bench/Bench/Remainder.hs
new file mode 100644
--- /dev/null
+++ b/bench/Bench/Remainder.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE MagicHash #-}
+
+module Bench.Remainder
+  ( benchRemainder
+  ) where
+
+import Data.Bit
+import qualified Data.Bit.ThreadSafe as TS
+import Data.Bits
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as MU
+import Gauge.Main
+import GHC.Exts
+import GHC.Integer.Logarithms
+import System.Random
+
+randomBools :: [Bool]
+randomBools
+  = map (\i -> if i > (0 :: Int) then True else False)
+  . randoms
+  . mkStdGen
+  $ 42
+
+randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
+randomVec f k = U.fromList (map f (take (2 * n) randomBools))
+  where
+    n = 1 `shiftL` k
+
+randomVec2 :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
+randomVec2 f k = U.fromList (map f (take n $ drop (2 * n) randomBools))
+  where
+    n = 1 `shiftL` k
+
+randomInteger :: Int -> Integer
+randomInteger k = toInteger $ toF2Poly $ randomVec Bit k
+
+randomInteger2 :: Int -> Integer
+randomInteger2 k = toInteger $ toF2Poly $ randomVec2 Bit k
+
+benchRemainder :: Int -> Benchmark
+benchRemainder k = bgroup (show (1 `shiftL` k :: Int))
+  [ bench "Bit/remainder"     $ nf (\x -> rem (toF2Poly $ randomVec Bit k) x) (toF2Poly $ randomVec2 Bit k)
+  -- , bench "Bit.TS/remainder"  $ nf (\x -> rem (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec2 TS.Bit k)
+  , bench "Integer/remainder" $ nf (\x -> binRem (randomInteger k) x) (randomInteger2 k)
+  ]
+
+binRem :: Integer -> Integer -> Integer
+binRem x y = go x
+  where
+    binLog n = I# (integerLog2# n)
+    ly = binLog y
+
+    go z = if lz < ly then z else go (z `xor` (y `shiftL` (lz - ly)))
+      where
+        lz = binLog z
diff --git a/bench/Bench/Sum.hs b/bench/Bench/Sum.hs
--- a/bench/Bench/Sum.hs
+++ b/bench/Bench/Sum.hs
@@ -5,6 +5,7 @@
 import Data.Bit
 import qualified Data.Bit.ThreadSafe as TS
 import Data.Bits
+import Data.List
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as MU
 import Gauge.Main
@@ -27,16 +28,18 @@
   where
     n = 1 `shiftL` k
 
+randomInteger :: Int -> Integer
+randomInteger k = toInteger $ toF2Poly $ randomVec Bit k
+
+randomInteger2 :: Int -> Integer
+randomInteger2 k = toInteger $ toF2Poly $ randomVec2 Bit k
+
 benchSum :: Int -> Benchmark
 benchSum k = bgroup (show (1 `shiftL` k :: Int))
-  [ bench "Bit/add"    $ nf (\x -> sumBit    (randomVec Bit k) x)    (randomVec2 Bit k)
-  , bench "Bit/sum"    $ nf sum [(1 :: F2Poly) .. fromInteger (1 `shiftL` k)]
-  , bench "Bit.TS/add" $ nf (\x -> sumBitTS  (randomVec TS.Bit k) x) (randomVec2 TS.Bit k)
-  , bench "Bit.TS/sum" $ nf sum [(1 :: TS.F2Poly) .. fromInteger (1 `shiftL` k)]
+  [ bench "Bit/add"     $ nf (\x -> (+) (toF2Poly $ randomVec Bit k) x)    (toF2Poly $ randomVec2 Bit k)
+  , bench "Bit/sum"     $ nf (foldl' (+) 0) [(1 :: F2Poly) .. fromInteger (1 `shiftL` k)]
+  , bench "Bit.TS/add"  $ nf (\x -> (+) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec2 TS.Bit k)
+  , bench "Bit.TS/sum"  $ nf (foldl' (+) 0) [(1 :: TS.F2Poly) .. fromInteger (1 `shiftL` k)]
+  , bench "Integer/add" $ nf (\x -> xor (randomInteger k) x) (randomInteger2 k)
+  , bench "Integer/sum" $ nf (foldl' xor 0) [(1 :: Integer) .. fromInteger (1 `shiftL` k)]
   ]
-
-sumBit :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
-sumBit xs ys = unF2Poly (toF2Poly xs + toF2Poly ys)
-
-sumBitTS :: U.Vector TS.Bit -> U.Vector TS.Bit -> U.Vector TS.Bit
-sumBitTS xs ys = TS.unF2Poly (TS.toF2Poly xs + TS.toF2Poly ys)
diff --git a/bitvec.cabal b/bitvec.cabal
--- a/bitvec.cabal
+++ b/bitvec.cabal
@@ -1,5 +1,5 @@
 name: bitvec
-version: 1.0.1.0
+version: 1.0.1.1
 cabal-version: >=1.10
 build-type: Simple
 license: BSD3
@@ -115,6 +115,7 @@
   build-depends:
     base >=4.8 && <5,
     bitvec,
+    integer-gmp,
     primitive >=0.5,
     quickcheck-classes >=0.6.1,
     vector >=0.11,
@@ -132,7 +133,7 @@
     Tests.MVectorTS
     Tests.SetOps
     Tests.Vector
-  ghc-options: -Wall
+  ghc-options: -Wall -threaded -rtsopts
   include-dirs: test
 
 benchmark gauge
@@ -141,6 +142,7 @@
     bitvec,
     containers,
     gauge,
+    integer-gmp,
     random,
     vector
   type: exitcode-stdio-1.0
@@ -155,6 +157,7 @@
     Bench.RandomFlip
     Bench.RandomRead
     Bench.RandomWrite
+    Bench.Remainder
     Bench.Reverse
     Bench.Sum
     Bench.Union
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,8 @@
+# 1.0.1.1
+
+* Fix bugs in 'F2Poly' multiplication.
+* Performance improvements.
+
 # 1.0.1.0
 
 * Implement arithmetic of binary polynomials.
diff --git a/src/Data/Bit/F2Poly.hs b/src/Data/Bit/F2Poly.hs
--- a/src/Data/Bit/F2Poly.hs
+++ b/src/Data/Bit/F2Poly.hs
@@ -34,14 +34,13 @@
 import Data.Bit.Utils
 import Data.Bits
 import Data.Coerce
-import Data.List hiding (dropWhileEnd)
+import Data.Primitive.ByteArray
 import Data.Typeable
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as MU
 import GHC.Generics
 
 #if UseIntegerGmp
-import Data.Primitive.ByteArray
 import qualified Data.Vector.Primitive as P
 import GHC.Exts
 import GHC.Integer.GMP.Internals
@@ -73,6 +72,12 @@
 toF2Poly :: U.Vector Bit -> F2Poly
 toF2Poly xs = F2Poly $ dropWhileEnd $ castFromWords $ cloneToWords xs
 
+-- | Valid 'F2Poly' has offset 0 and no trailing garbage.
+_isValid :: F2Poly -> Bool
+_isValid (F2Poly (BitVec o l arr)) = o == 0 && l == l'
+  where
+    l' = U.length $ dropWhileEnd $ BitVec 0 (sizeofByteArray arr `shiftL` 3) arr
+
 -- | Addition and multiplication are evaluated modulo 2.
 --
 -- 'abs' = 'id' and 'signum' = 'const' 1.
@@ -96,6 +101,14 @@
   fromInteger = F2Poly . dropWhileEnd . integerToBits
 #endif
 
+  {-# INLINE (+)         #-}
+  {-# INLINE (-)         #-}
+  {-# INLINE negate      #-}
+  {-# INLINE abs         #-}
+  {-# INLINE signum      #-}
+  {-# INLINE (*)         #-}
+  {-# INLINE fromInteger #-}
+
 instance Enum F2Poly where
   fromEnum = fromIntegral
 #if UseIntegerGmp
@@ -115,19 +128,19 @@
   quotRem (F2Poly xs) (F2Poly ys) = (F2Poly (dropWhileEnd qs), F2Poly (dropWhileEnd rs))
     where
       (qs, rs) = quotRemBits xs ys
-  rem = coerce ((dropWhileEnd .) . remBits)
   divMod = quotRem
   mod = rem
 
+-- | Inputs must be valid for wrapping into F2Poly: no trailing garbage is allowed.
 xorBits
   :: U.Vector Bit
   -> U.Vector Bit
   -> U.Vector Bit
+xorBits (BitVec _ 0 _) ys = ys
+xorBits xs (BitVec _ 0 _) = xs
 #if UseIntegerGmp
 -- GMP has platform-dependent ASM implementations for mpn_xor_n,
 -- which are impossible to beat by native Haskell.
-xorBits (BitVec _ 0 _) ys = ys
-xorBits xs (BitVec _ 0 _) = xs
 xorBits (BitVec 0 lx xarr) (BitVec 0 ly yarr) = case lx `compare` ly of
   LT -> BitVec 0 ly zs
   EQ -> dropWhileEnd $ BitVec 0 (lx `min` (sizeofByteArray zs `shiftL` 3)) zs
@@ -145,12 +158,14 @@
   U.unsafeCopy (MU.drop shorterLen zs) (U.drop shorterLen longer)
   U.unsafeFreeze zs
 
--- | Must be >= wordSize.
+-- | Must be >= 2 * wordSize.
 karatsubaThreshold :: Int
-karatsubaThreshold = 4096
+karatsubaThreshold = 2048
 
 karatsuba :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
 karatsuba xs ys
+  | karatsubaThreshold < 2 * wordSize
+  = error $ "karatsubaThreshold must be >= " ++ show (2 * wordSize)
   | xs == ys = sqrBits xs
   | lenXs <= karatsubaThreshold || lenYs <= karatsubaThreshold
   = mulBits xs ys
@@ -170,12 +185,12 @@
     lenZs = lenXs + lenYs - 1
 
     m'    = ((lenXs `min` lenYs) + 1) `quot` 2
-    m     = if karatsubaThreshold < wordSize then m' else m' - modWordSize m'
+    m     = m' - modWordSize m'
 
-    xs0  = U.slice 0 m xs
-    xs1  = U.slice m (lenXs - m) xs
-    ys0  = U.slice 0 m ys
-    ys1  = U.slice m (lenYs - m) ys
+    xs0  = U.unsafeSlice 0 m xs
+    xs1  = U.unsafeSlice m (lenXs - m) xs
+    ys0  = U.unsafeSlice 0 m ys
+    ys1  = U.unsafeSlice m (lenYs - m) ys
 
     xs01 = xorBits xs0 xs1
     ys01 = xorBits ys0 ys1
@@ -199,77 +214,24 @@
 mulBits :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
 mulBits xs ys
   | lenXs == 0 || lenYs == 0 = U.empty
-  | lenXs <= wordSize && lenYs <= wordSize = mulShortShort x0 y0
-  | lenYs <= wordSize                      = mulLongShort  xs y0
-  | lenXs <= wordSize                      = mulLongShort  ys x0
-  | otherwise = runST $ do
-    zs <- MU.replicate lenZs (Bit False)
-    forM_ [0 .. lenYs - 1] $ \k ->
-      MU.unsafeWrite zs k
-        (zipAndCountParityBits xs (U.unsafeSlice (lenYs - 1 - k) (k + 1) rys))
-    forM_ [lenYs .. lenZs - 1] $ \k ->
-      MU.unsafeWrite zs k
-        (zipAndCountParityBits (U.unsafeSlice (k - (lenYs - 1)) (lenXs + lenYs + 1 - k) xs) rys)
-    U.unsafeFreeze zs
+  | lenXs >= lenYs           = mulBits' xs ys
+  | otherwise                = mulBits' ys xs
   where
     lenXs = U.length xs
     lenYs = U.length ys
-    lenZs = lenXs + lenYs - 1
-    rys   = reverseBits ys
-    x0 = indexWord xs 0 .&. loMask lenXs
-    y0 = indexWord ys 0 .&. loMask lenYs
 
-mulShortShort :: Word -> Word -> U.Vector Bit
-mulShortShort xs ys = runST $ do
-  zs <- MU.replicate lenZs (Bit False)
-  forM_ [0 .. lenYs - 1] $ \k -> do
-    let yk = rys `shiftR` (lenYs - 1 - k)
-        l  = (k + 1) `min` lenXs
-    MU.unsafeWrite zs k (fromIntegral $ popCount $ xs .&. yk .&. loMask l)
-  forM_ [lenYs .. lenZs - 1] $ \k -> do
-    let xk = xs `shiftR` (k - (lenYs - 1))
-        l  = (lenXs + lenYs + 1 - k) `min` lenYs
-    MU.unsafeWrite zs k (fromIntegral $ popCount $ xk .&. rys .&. loMask l)
-  U.unsafeFreeze zs
-  where
-    clzXs = countLeadingZeros xs
-    lenXs = wordSize - clzXs
-    clzYs = countLeadingZeros ys
-    lenYs = wordSize - clzYs
-    lenZs = lenXs + lenYs - 1
-    rys   = reverseWord (ys `shiftL` clzYs)
-
-mulLongShort :: U.Vector Bit -> Word -> U.Vector Bit
-mulLongShort xs ys = runST $ do
+mulBits' :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
+mulBits' xs ys = runST $ do
   zs <- MU.replicate lenZs (Bit False)
-  forM_ [0 .. lenYs - 1] $ \k -> do
-    let yk = rys `shiftR` (lenYs - 1 - k)
-        l  = (k + 1) `min` lenXs
-    MU.unsafeWrite zs k (fromIntegral $ popCount $ x0 .&. yk .&. loMask l)
-  forM_ [lenYs .. lenZs - 1] $ \k -> do
-    let xk = indexWord xs (k - (lenYs - 1))
-        l  = (lenXs + lenYs + 1 - k) `min` lenYs
-    MU.unsafeWrite zs k (fromIntegral $ popCount $ xk .&. rys .&. loMask l)
+  forM_ [0 .. lenYs - 1] $ \k ->
+    when (unBit (U.unsafeIndex ys k)) $
+      zipInPlace xor xs (MU.unsafeSlice k (lenZs - k) zs)
   U.unsafeFreeze zs
   where
     lenXs = U.length xs
-    clzYs = countLeadingZeros ys
-    lenYs = wordSize - clzYs
+    lenYs = U.length ys
     lenZs = lenXs + lenYs - 1
-    rys   = reverseWord (ys `shiftL` clzYs)
-    x0    = indexWord xs 0
 
-zipAndCountParityBits :: U.Vector Bit -> U.Vector Bit -> Bit
-zipAndCountParityBits xs ys
-  | nMod == 0 = fromIntegral $ popCnt
-  | otherwise = fromIntegral $ popCnt `xor` lastPopCnt
-  where
-    n = min (U.length xs) (U.length ys)
-    nMod = modWordSize n
-    ff i = indexWord xs i .&. indexWord ys i
-    popCnt = foldl' (\acc i -> acc `xor` popCount (ff i)) 0 [0, wordSize .. n - nMod - 1]
-    lastPopCnt = popCount (ff (n - nMod) .&. loMask nMod)
-
 sqrBits :: U.Vector Bit -> U.Vector Bit
 sqrBits xs = runST $ do
     let lenXs = U.length xs
@@ -298,23 +260,6 @@
         zipInPlace xor ys (MU.drop i rs)
     let rs' = MU.unsafeSlice 0 lenYs rs
     (,) <$> U.unsafeFreeze qs <*> U.unsafeFreeze rs'
-
-remBits :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
-remBits xs ys
-  | U.null ys = throw DivideByZero
-  | U.length xs < U.length ys = xs
-  | otherwise = runST $ do
-    let lenXs = U.length xs
-        lenYs = U.length ys
-        lenQs = lenXs - lenYs + 1
-    rs <- MU.replicate lenXs (Bit False)
-    U.unsafeCopy rs xs
-    forM_ [lenQs - 1, lenQs - 2 .. 0] $ \i -> do
-      Bit r <- MU.unsafeRead rs (lenYs - 1 + i)
-      when r $ do
-        zipInPlace xor ys (MU.drop i rs)
-    let rs' = MU.unsafeSlice 0 lenYs rs
-    U.unsafeFreeze rs'
 
 dropWhileEnd
   :: U.Vector Bit
diff --git a/src/Data/Bit/Immutable.hs b/src/Data/Bit/Immutable.hs
--- a/src/Data/Bit/Immutable.hs
+++ b/src/Data/Bit/Immutable.hs
@@ -28,7 +28,9 @@
 import Control.Monad
 import Control.Monad.ST
 import Data.Bits
+#if UseLibGmp
 import Data.Bit.Gmp
+#endif
 #ifndef BITVEC_THREADSAFE
 import Data.Bit.Internal
 import Data.Bit.Mutable
diff --git a/src/Data/Bit/Internal.hs b/src/Data/Bit/Internal.hs
--- a/src/Data/Bit/Internal.hs
+++ b/src/Data/Bit/Internal.hs
@@ -139,7 +139,7 @@
 
 -- | read a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.).  If the offset is such that the word extends past the end of the vector, the result is padded with memory garbage.
 indexWord :: U.Vector Bit -> Int -> Word
-indexWord (BitVec off len' arr) i' = word
+indexWord !(BitVec off len' arr) !i' = word
  where
   len    = off + len'
   i      = off + i'
@@ -155,10 +155,11 @@
       else
         (loWord `unsafeShiftR` nMod)
           .|. (hiWord `unsafeShiftL` (wordSize - nMod))
+{-# INLINE indexWord #-}
 
 -- | read a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.).  If the offset is such that the word extends past the end of the vector, the result is padded with memory garbage.
 readWord :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m Word
-readWord (BitMVec off len' arr) i' = do
+readWord !(BitMVec off len' arr) !i' = do
   let len  = off + len'
       i    = off + i'
       nMod = modWordSize i
@@ -177,10 +178,11 @@
 #if __GLASGOW_HASKELL__ >= 800
 {-# SPECIALIZE readWord :: U.MVector s Bit -> Int -> ST s Word #-}
 #endif
+{-# INLINE readWord #-}
 
 -- | write a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.).  If the offset is such that the word extends past the end of the vector, the word is truncated and as many low-order bits as possible are written.
 writeWord :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> Word -> m ()
-writeWord (BitMVec off len' arr) i' x = do
+writeWord !(BitMVec off len' arr) !i' !x = do
   let len    = off + len'
       lenMod = modWordSize len
       i      = off + i'
@@ -219,6 +221,7 @@
 #if __GLASGOW_HASKELL__ >= 800
 {-# SPECIALIZE writeWord :: U.MVector s Bit -> Int -> Word -> ST s () #-}
 #endif
+{-# INLINE writeWord #-}
 
 instance MV.MVector U.MVector Bit where
   {-# INLINE basicInitialize #-}
diff --git a/src/Data/Bit/Mutable.hs b/src/Data/Bit/Mutable.hs
--- a/src/Data/Bit/Mutable.hs
+++ b/src/Data/Bit/Mutable.hs
@@ -1,8 +1,9 @@
 {-# LANGUAGE CPP              #-}
 
-{-# LANGUAGE BangPatterns     #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes       #-}
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 #ifndef BITVEC_THREADSAFE
 module Data.Bit.Mutable
@@ -32,6 +33,7 @@
 #endif
 import Data.Bit.Utils
 import Data.Bits
+import Data.Primitive.ByteArray
 import qualified Data.Vector.Primitive as P
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as MU
@@ -57,7 +59,9 @@
 -- If the bits don't completely fill the words, the last word will be zero-padded.
 -- Cf. 'Data.Bit.cloneToWords'.
 cloneToWordsM
-  :: PrimMonad m => MVector (PrimState m) Bit -> m (MVector (PrimState m) Word)
+  :: PrimMonad m
+  => MVector (PrimState m) Bit
+  -> m (MVector (PrimState m) Word)
 cloneToWordsM v = do
   let lenBits  = MU.length v
       lenWords = nWords lenBits
@@ -82,17 +86,78 @@
 -- >>> modify (zipInPlace (.&.) (read "[1,1,0]")) (read "[0,1,1,1,1,1]")
 -- [0,1,0,1,1,1] -- note trailing garbage
 zipInPlace
-  :: PrimMonad m
+  :: forall m.
+     PrimMonad m
   => (forall a . Bits a => a -> a -> a)
   -> Vector Bit
   -> MVector (PrimState m) Bit
   -> m ()
-zipInPlace f xs ys = do
-  let n = min (U.length xs) (MU.length ys)
-  forM_ [0, wordSize .. n - 1] $ \i -> do
-    let x = indexWord xs i
-    y <- readWord ys i
-    writeWord ys i (f x y)
+zipInPlace f (BitVec off l xs) (BitMVec off' l' ys) =
+  go (l `min` l') off off'
+  where
+    go :: Int -> Int -> Int -> m ()
+    go len offXs offYs
+      | shft == 0 =
+        go' len offXs (divWordSize offYs)
+      | len <= wordSize = do
+        y <- readWord vecYs 0
+        writeWord vecYs 0 (f x y)
+      | otherwise = do
+        y <- readByteArray ys base
+        writeByteArray ys base $
+          (y .&. loMask shft) .|. (f (x `unsafeShiftL` shft) y .&. hiMask shft)
+        go' (len - wordSize + shft) (offXs + wordSize - shft) (base + 1)
+      where
+        vecXs = BitVec  offXs len xs
+        vecYs = BitMVec offYs len ys
+        x     = indexWord vecXs 0
+        shft  = modWordSize offYs
+        base  = divWordSize offYs
+
+    go' :: Int -> Int -> Int -> m ()
+    go' len offXs offYsW = do
+      if shft == 0
+        then loopAligned offYsW
+        else loop offYsW (indexByteArray xs base)
+      when (modWordSize len /= 0) $ do
+        let ix = len - modWordSize len
+        let x = indexWord vecXs ix
+        y <- readWord vecYs ix
+        writeWord vecYs ix (f x y)
+
+      where
+
+        vecXs = BitVec  offXs len xs
+        vecYs = BitMVec (mulWordSize offYsW) len ys
+        shft  = modWordSize offXs
+        shft' = wordSize - shft
+        base  = divWordSize offXs
+        base0 = base - offYsW
+        base1 = base0 + 1
+        iMax  = divWordSize len + offYsW
+
+        loopAligned :: Int -> m ()
+        loopAligned !i
+          | i >= iMax = pure ()
+          | otherwise =  do
+            let x = indexByteArray xs (base0 + i) :: Word
+            y <- readByteArray ys i
+            writeByteArray ys i (f x y)
+            loopAligned (i + 1)
+
+        loop :: Int -> Word -> m ()
+        loop !i !acc
+          | i >= iMax = pure ()
+          | otherwise =  do
+            let accNew = indexByteArray xs (base1 + i)
+                x = (acc `unsafeShiftR` shft) .|. (accNew `unsafeShiftL` shft')
+            y <- readByteArray ys i
+            writeByteArray ys i (f x y)
+            loop (i + 1) accNew
+
+#if __GLASGOW_HASKELL__ >= 800
+{-# SPECIALIZE zipInPlace :: (forall a. Bits a => a -> a -> a) -> Vector Bit -> MVector s Bit -> ST s () #-}
+#endif
 {-# INLINE zipInPlace #-}
 
 -- | Invert (flip) all bits in-place.
diff --git a/src/Data/Bit/Utils.hs b/src/Data/Bit/Utils.hs
--- a/src/Data/Bit/Utils.hs
+++ b/src/Data/Bit/Utils.hs
@@ -53,6 +53,7 @@
 
 mulWordSize :: Bits a => a -> a
 mulWordSize x = unsafeShiftL x lgWordSize
+{-# INLINE mulWordSize #-}
 
 -- number of words needed to store n bits
 nWords :: Int -> Int
@@ -187,13 +188,17 @@
 #endif
 
 loMask :: Int -> Word
-loMask n = 1 `shiftL` n - 1
+loMask n = 1 `unsafeShiftL` n - 1
+{-# INLINE loMask #-}
 
 hiMask :: Int -> Word
-hiMask n = complement (1 `shiftL` n - 1)
+hiMask n = complement (1 `unsafeShiftL` n - 1)
+{-# INLINE hiMask #-}
 
 fromPrimVector :: P.Vector Word -> U.Vector Word
 fromPrimVector = unsafeCoerce
+{-# INLINE fromPrimVector #-}
 
 toPrimVector :: U.Vector Word -> P.Vector Word
 toPrimVector = unsafeCoerce
+{-# INLINE toPrimVector #-}
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,27 +1,38 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP       #-}
+{-# LANGUAGE MagicHash #-}
 
 module Main where
 
 import Data.Bit
+import Data.Bits
 import Data.Proxy
+import qualified Data.Vector.Unboxed as U
+import GHC.Exts
+import GHC.Integer.Logarithms
 import Test.QuickCheck.Classes
 import Test.Tasty
 import Test.Tasty.QuickCheck
 
+import Support
 import Tests.MVector (mvectorTests)
 import qualified Tests.MVectorTS as TS (mvectorTests)
 import Tests.SetOps (setOpTests)
 import Tests.Vector (vectorTests)
 
 main :: IO ()
-main = defaultMain $ testGroup
-  "All"
-  [lawsTests, f2polyTests, mvectorTests, TS.mvectorTests, setOpTests, vectorTests]
+main = defaultMain $ testGroup "All"
+  [ lawsTests
+  , f2polyTests
+  , mvectorTests
+  , TS.mvectorTests
+  , setOpTests
+  , vectorTests
+  ]
 
 lawsTests :: TestTree
-lawsTests = testGroup "Laws"
-  $ map (uncurry testProperty)
-  $ concatMap lawsProperties
+lawsTests = adjustOption (const $ QuickCheckTests 100)
+  $ testGroup "Bit"
+  $ map lawsToTest
   [ bitsLaws        (Proxy :: Proxy Bit)
   , eqLaws          (Proxy :: Proxy Bit)
   , ordLaws         (Proxy :: Proxy Bit)
@@ -36,12 +47,48 @@
 
 f2polyTests :: TestTree
 f2polyTests = testGroup "F2Poly"
-  $ map (uncurry testProperty)
-  $ concatMap lawsProperties
-  [ showLaws        (Proxy :: Proxy F2Poly)
+  [ testProperty "Addition"       prop_f2polyAdd
+  , testProperty "Multiplication" prop_f2polyMul
+  , tenTimesLess $ testProperty "Multiplication long" prop_f2polyMulLong
+  , testProperty "Remainder"      prop_f2polyRem
+  , tenTimesLess $ lawsToTest $
+    showLaws (Proxy :: Proxy F2Poly)
 #if MIN_VERSION_quickcheck_classes(0,6,3)
-  , numLaws         (Proxy :: Proxy F2Poly)
+  , lawsToTest $
+    numLaws (Proxy :: Proxy F2Poly)
 #endif
-  , integralLaws    (Proxy :: Proxy F2Poly)
+  , lawsToTest $
+    integralLaws (Proxy :: Proxy F2Poly)
   ]
 
+prop_f2polyAdd :: F2Poly -> F2Poly -> Property
+prop_f2polyAdd x y = x + y === fromInteger (toInteger x `xor` toInteger y)
+
+prop_f2polyMul :: F2Poly -> F2Poly -> Property
+prop_f2polyMul x y = x * y === fromInteger (toInteger x `binMul` toInteger y)
+
+prop_f2polyMulLong :: U.Vector Word -> U.Vector Word -> Property
+prop_f2polyMulLong xs ys = x * y === fromInteger (toInteger x `binMul` toInteger y)
+  where
+    x = toF2Poly $ castFromWords xs
+    y = toF2Poly $ castFromWords ys
+
+prop_f2polyRem :: F2Poly -> F2Poly -> Property
+prop_f2polyRem x y = y /= 0 ==> x `rem` y === fromInteger (toInteger x `binRem` toInteger y)
+
+binMul :: Integer -> Integer -> Integer
+binMul = go 0
+  where
+    go :: Integer -> Integer -> Integer -> Integer
+    go acc _ 0 = acc
+    go acc x y = go (if odd y then acc `xor` x else acc) (x `shiftL` 1) (y `shiftR` 1)
+
+binRem :: Integer -> Integer -> Integer
+binRem x y = go x
+  where
+    binLog n = I# (integerLog2# n)
+    ly = binLog y
+
+    go z = if lz < ly then z else go (z `xor` (y `shiftL` (lz - ly)))
+      where
+        lz = binLog z
diff --git a/test/Support.hs b/test/Support.hs
--- a/test/Support.hs
+++ b/test/Support.hs
@@ -15,6 +15,8 @@
 import qualified Data.Vector.Generic.Mutable as M
 import qualified Data.Vector.Generic.New as N
 import qualified Data.Vector.Unboxed as U
+import Test.QuickCheck.Classes
+import Test.Tasty
 import Test.Tasty.QuickCheck
 
 instance Arbitrary Bit where
@@ -131,3 +133,11 @@
   -> Property
 withNonEmptyMVec f g = forAll arbitrary $ \xs ->
   let xs' = V.new xs in not (U.null xs') ==> f xs' === runST (N.run xs >>= g)
+
+tenTimesLess :: TestTree -> TestTree
+tenTimesLess = adjustOption $
+  \(QuickCheckTests n) -> QuickCheckTests (max 100 (n `div` 10))
+
+lawsToTest :: Laws -> TestTree
+lawsToTest (Laws name props) =
+  testGroup name $ map (uncurry testProperty) props
diff --git a/test/Tests/MVector.hs b/test/Tests/MVector.hs
--- a/test/Tests/MVector.hs
+++ b/test/Tests/MVector.hs
@@ -27,20 +27,18 @@
 import Test.Tasty.QuickCheck
 
 mvectorTests :: TestTree
-mvectorTests = testGroup
-  "Data.Vector.Unboxed.Mutable.Bit"
-  [ testGroup
-    "Data.Vector.Unboxed.Mutable functions"
-    [testProperty "slice" prop_slice_def, testProperty "grow" prop_grow_def]
-  , testGroup
-    "Read/write Words"
-    [ testProperty "cloneFromWords" prop_cloneFromWords_def
+mvectorTests = testGroup "Data.Vector.Unboxed.Mutable.Bit"
+  [ testGroup "Data.Vector.Unboxed.Mutable functions"
+    [ tenTimesLess $
+      testProperty "slice" prop_slice_def
+    , testProperty "grow"  prop_grow_def
+    ]
+  , testGroup "Read/write Words"
+    [ tenTimesLess $
+      testProperty "cloneFromWords" prop_cloneFromWords_def
     , testProperty "cloneToWords"   prop_cloneToWords_def
     ]
-  , testGroup "MVector laws"
-  $ map (uncurry testProperty)
-  $ lawsProperties
-  $ muvectorLaws (Proxy :: Proxy Bit)
+  , lawsToTest $ muvectorLaws (Proxy :: Proxy Bit)
   , testCase "basicInitialize 1" case_write_init_read1
   , testCase "basicInitialize 2" case_write_init_read2
   , testCase "basicInitialize 3" case_write_init_read3
@@ -58,14 +56,16 @@
   , testCase "basicUnsafeCopy3"  case_write_copy_read3
   , testCase "basicUnsafeCopy4"  case_write_copy_read4
   , testCase "basicUnsafeCopy5"  case_write_copy_read5
-  , testProperty "flipBit" prop_flipBit
+  , tenTimesLess $
+    testProperty "flipBit" prop_flipBit
   ]
 
 prop_flipBit :: B.Vector Bit -> NonNegative Int -> Property
-prop_flipBit xs (NonNegative k) = k < B.length xs ==> ys === ys'
- where
-  ys  = B.modify (\v -> M.modify v complement k) xs
-  ys' = B.modify (\v -> flipBit v k) xs
+prop_flipBit xs (NonNegative k) = B.length xs > 0 ==> ys === ys'
+  where
+    k'  = k `mod` B.length xs
+    ys  = B.modify (\v -> M.modify v complement k') xs
+    ys' = B.modify (\v -> flipBit v k') xs
 
 case_write_init_read1 :: IO ()
 case_write_init_read1 = assertEqual "should be equal" (Bit True) $ runST $ do
@@ -196,13 +196,20 @@
   M.read dst 46
 
 prop_slice_def
-  :: NonNegative Int -> NonNegative Int -> N.New B.Vector Bit -> Property
+  :: NonNegative Int
+  -> NonNegative Int
+  -> N.New B.Vector Bit
+  -> Property
 prop_slice_def (NonNegative s) (NonNegative n) xs =
-  s + n < V.length (V.new xs) ==> runST $ do
+  l > 0 ==> runST $ do
     let xs' = V.new xs
     xs1 <- N.run xs
-    xs2 <- V.unsafeFreeze (M.slice s n xs1)
-    return (B.toList xs2 === sliceList s n (B.toList xs'))
+    xs2 <- V.unsafeFreeze (M.slice s' n' xs1)
+    return (B.toList xs2 === sliceList s' n' (B.toList xs'))
+  where
+    l = V.length (V.new xs)
+    s' = s `mod` l
+    n' = n `mod` (l - s')
 
 prop_grow_def :: B.Vector Bit -> NonNegative Int -> Bool
 prop_grow_def xs (NonNegative m) = runST $ do
diff --git a/test/Tests/SetOps.hs b/test/Tests/SetOps.hs
--- a/test/Tests/SetOps.hs
+++ b/test/Tests/SetOps.hs
@@ -21,8 +21,6 @@
   , testProperty "invertInPlace"   prop_invertInPlace
   , testProperty "reverseBits"     prop_reverseBits
   , testProperty "reverseInPlace"  prop_reverseInPlace
-  , testProperty "select"          prop_select_def
-  , testProperty "exclude"         prop_exclude_def
   , testProperty "selectBits"      prop_selectBits_def
   , testProperty "excludeBits"     prop_excludeBits_def
   , testProperty "countBits"       prop_countBits_def
@@ -83,29 +81,20 @@
 prop_reverseInPlace xs =
   U.reverse xs === U.modify reverseInPlace xs
 
-select :: U.Unbox a => U.Vector Bit -> U.Vector a -> [a]
-select mask ws = U.toList (U.map snd (U.filter (unBit . fst) (U.zip mask ws)))
-
-prop_select_def :: U.Vector Bit -> U.Vector Word -> Bool
-prop_select_def xs ys =
-  select xs ys == [ x | (Bit True, x) <- zip (U.toList xs) (U.toList ys) ]
-
-exclude :: U.Unbox a => U.Vector Bit -> U.Vector a -> [a]
-exclude mask ws =
-  U.toList (U.map snd (U.filter (not . unBit . fst) (U.zip mask ws)))
+select :: U.Unbox a => U.Vector Bit -> U.Vector a -> U.Vector a
+select mask ws = U.map snd (U.filter (unBit . fst) (U.zip mask ws))
 
-prop_exclude_def :: U.Vector Bit -> U.Vector Word -> Bool
-prop_exclude_def xs ys =
-  exclude xs ys == [ x | (Bit False, x) <- zip (U.toList xs) (U.toList ys) ]
+exclude :: U.Unbox a => U.Vector Bit -> U.Vector a -> U.Vector a
+exclude mask ws = U.map snd (U.filter (not . unBit . fst) (U.zip mask ws))
 
-prop_selectBits_def :: U.Vector Bit -> U.Vector Bit -> Bool
-prop_selectBits_def xs ys = selectBits xs ys == U.fromList (select xs ys)
+prop_selectBits_def :: U.Vector Bit -> U.Vector Bit -> Property
+prop_selectBits_def xs ys = selectBits xs ys === select xs ys
 
-prop_excludeBits_def :: U.Vector Bit -> U.Vector Bit -> Bool
-prop_excludeBits_def xs ys = excludeBits xs ys == U.fromList (exclude xs ys)
+prop_excludeBits_def :: U.Vector Bit -> U.Vector Bit -> Property
+prop_excludeBits_def xs ys = excludeBits xs ys === exclude xs ys
 
-prop_countBits_def :: U.Vector Bit -> Bool
-prop_countBits_def xs = countBits xs == U.length (selectBits xs xs)
+prop_countBits_def :: U.Vector Bit -> Property
+prop_countBits_def xs = countBits xs === U.length (selectBits xs xs)
 
 -------------------------------------------------------------------------------
 
diff --git a/test/Tests/Vector.hs b/test/Tests/Vector.hs
--- a/test/Tests/Vector.hs
+++ b/test/Tests/Vector.hs
@@ -11,24 +11,26 @@
 import Test.Tasty.QuickCheck
 
 vectorTests :: TestTree
-vectorTests = testGroup
-  "Data.Vector.Unboxed.Bit"
-  [ testGroup
-    "Data.Vector.Unboxed functions"
+vectorTests = testGroup "Data.Vector.Unboxed.Bit"
+  [ testGroup "Data.Vector.Unboxed functions"
     [ testProperty "toList . fromList == id" prop_toList_fromList
     , testProperty "fromList . toList == id" prop_fromList_toList
     , testProperty "slice"                   prop_slice_def
     ]
-  , testProperty "cloneFromWords" prop_cloneFromWords_def
+  , tenTimesLess $
+    testProperty "cloneFromWords" prop_cloneFromWords_def
   , testProperty "cloneToWords"   prop_cloneToWords_def
   , testProperty "reverse"        prop_reverse_def
   , testProperty "countBits"      prop_countBits_def
   , testProperty "listBits"       prop_listBits_def
   , testGroup "Boolean operations"
-              [testProperty "and" prop_and_def, testProperty "or" prop_or_def]
-  , testGroup "Search operations" [testProperty "first" prop_first_def]
-  , testGroup
-    "nthBitIndex"
+    [ testProperty "and" prop_and_def
+    , testProperty "or" prop_or_def
+    ]
+  , testGroup "Search operations"
+    [ testProperty "first" prop_first_def
+    ]
+  , testGroup "nthBitIndex"
     [ testCase "special case 1" case_nthBit_1
     , testProperty "matches bitIndex True"              prop_nthBit_1
     , testProperty "matches bitIndex False"             prop_nthBit_2
@@ -115,10 +117,13 @@
       Just k  -> i === j + k + 1
 
 prop_nthBit_5 :: Positive Int -> U.Vector Bit -> Property
-prop_nthBit_5 (Positive n) xs =
-  n <= countBits xs ==> case nthBitIndex (Bit True) n xs of
+prop_nthBit_5 (Positive n) xs = count > 0 ==>
+  case nthBitIndex (Bit True) n' xs of
     Nothing -> property False
-    Just i  -> countBits (U.take (i + 1) xs) === n
+    Just i  -> countBits (U.take (i + 1) xs) === n'
+  where
+    count = countBits xs
+    n' = n `mod` count + 1
 
 case_nthBit_1 :: IO ()
 case_nthBit_1 =