diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,18 @@
+# v0.2.0
+
+- Fix the slicing/take/drop operations
+
+  The operations now have worse performance (linear), but are at least correct.  They will be replaced by more efficient implementations in later version.
+
+- Implement additional fold variants (David Feuer @treeowl)
+- Improve the representation of the `Vector (David Feuer @treeowl)
+
+  It is now more compact and unboxes better. This removes some "impossible" cases from the code.
+
+- Strictness fixes (David Feuer @treeowl)
+
+  Includes making `snoc` more strict, which should improve performance.
+
+- Fix the traversal order in `traverse`
+
+  Before, the tail was traversed in the wrong order.
diff --git a/persistent-vector.cabal b/persistent-vector.cabal
--- a/persistent-vector.cabal
+++ b/persistent-vector.cabal
@@ -1,16 +1,17 @@
 name: persistent-vector
-version: 0.1.1
+version: 0.2.0
 synopsis: A persistent sequence based on array mapped tries
 license: BSD3
 license-file: LICENSE
 author: Tristan Ravitch
-maintainer: tristan@nochair.net
+maintainer: tristan@ravit.ch
 category: Data
 build-type: Simple
 cabal-version: >=1.10
-extra-source-files: README.md
+extra-source-files: README.md, ChangeLog.md
 homepage: https://github.com/travitch/persistent-vector
 bug-reports: https://github.com/travitch/persistent-vector/issues
+tested-with: GHC == 7.10.2, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2
 
 description:
   This package provides persistent vectors based on array mapped
@@ -39,11 +40,15 @@
   default-language: Haskell2010
   exposed-modules: Data.Vector.Persistent
   other-modules: Data.Vector.Persistent.Array
-                 Data.Vector.Persistent.Unsafe
-  build-depends: base ==4.*, deepseq
+  build-depends: base ==4.*,
+                 deepseq >= 1 && < 1.5,
+                 transformers >= 0.3 && < 0.6
+  if !impl(ghc >= 8.0)
+    build-depends: semigroups == 0.18.*
   hs-source-dirs: src
   ghc-options: -Wall
-  ghc-prof-options: -auto-all
+  if impl(ghc >= 8.0)
+     ghc-options: -Wcompat
 
 test-suite pvTests
   default-language: Haskell2010
@@ -53,9 +58,9 @@
   ghc-options: -Wall
   build-depends: persistent-vector,
                  base == 4.*,
-                 QuickCheck > 2.4,
-                 test-framework,
-                 test-framework-quickcheck2
+                 QuickCheck > 2.4 && < 2.15,
+                 test-framework >= 0.6 && < 0.9,
+                 test-framework-quickcheck2 >= 0.3 && < 0.4
 
 benchmark pvBench
   default-language: Haskell2010
@@ -63,11 +68,10 @@
   hs-source-dirs: bench
   main-is: pvBench.hs
   ghc-options: -Wall -O2
-  ghc-prof-options: -auto-all
   build-depends: persistent-vector,
                  base == 4.*,
                  containers,
-                 criterion >= 1 && < 1.2,
+                 criterion >= 1 && < 1.6,
                  deepseq
 
 source-repository head
diff --git a/src/Data/Vector/Persistent.hs b/src/Data/Vector/Persistent.hs
--- a/src/Data/Vector/Persistent.hs
+++ b/src/Data/Vector/Persistent.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE BangPatterns #-}
+{- OPTIONS_GHC -Wall #-}
+
 -- | This is a port of the persistent vector from clojure to Haskell.
 -- It is spine-strict and lazy in the elements.
 --
@@ -5,6 +10,10 @@
 -- bounds given are mostly O(1), but only if you are willing to accept
 -- that the tree cannot have height greater than 7 on 32 bit systems
 -- and maybe 8 on 64 bit systems.
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{- options_ghc -ddump-simpl #-}
+
 module Data.Vector.Persistent (
   Vector,
   -- * Construction
@@ -12,569 +21,567 @@
   singleton,
   snoc,
   fromList,
+  append,
   -- * Queries
   null,
   length,
   -- * Indexing
   index,
   unsafeIndex,
+  unsafeIndexA,
+  unsafeIndex#,
   take,
   drop,
   splitAt,
-  -- * Slicing
   slice,
+  -- ** Slicing Storage Management
   shrink,
   -- * Modification
   update,
   (//),
   -- * Folds
   foldr,
+  foldr',
+  foldl,
   foldl',
   -- * Transformations
   map,
   reverse,
   -- * Searches
-  filter,
-  partition,
   takeWhile,
-  dropWhile
+  dropWhile,
+  filter,
+  partition
   ) where
 
-import Prelude hiding ( null, length, tail, take,
-                        drop, map, foldr, reverse,
-                        splitAt, filter, takeWhile, dropWhile
-                      )
+import Prelude hiding
+  ( null, length, tail, take
+  , drop, map, foldr, foldl
+  , reverse, splitAt, filter
+  , takeWhile, dropWhile )
 
 import qualified Control.Applicative as Ap
 import Control.DeepSeq
-import Data.Bits
+import Data.Bits hiding (shiftR, shiftL)
 import qualified Data.Foldable as F
 import qualified Data.List as L
-import qualified Data.Monoid as M
+import Data.Semigroup as Sem
 import qualified Data.Traversable as T
+import Control.Applicative.Backwards
 
 import Data.Vector.Persistent.Array ( Array )
 import qualified Data.Vector.Persistent.Array as A
+#if !MIN_VERSION_base(4,8,0)
+import Data.Word (Word)
+#endif
 
 -- Note: using Int here doesn't give the full range of 32 bits on a 32
 -- bit machine (it is fine on 64)
 
 -- | Persistent vectors based on array mapped tries
-data Vector a = EmptyVector
-              | RootNode { vecSize :: {-# UNPACK #-} !Int
-                         , vecShift :: {-# UNPACK #-} !Int
-                         , vecOffset :: {-# UNPACK #-} !Int
-                         , vecCapacity :: {-# UNPACK #-} !Int
-                         , vecTail :: ![a]
-                         , intVecPtrs :: {-# UNPACK #-} !(Array (Vector a))
-                         }
-              | InternalNode { intVecPtrs :: {-# UNPACK #-} !(Array (Vector a))
-                             }
-              | DataNode { dataVec :: {-# UNPACK #-} !(Array a)
-                         }
-              deriving (Show)
+data Vector a
+  = RootNode
+     { vecSize :: !Int
+     , vecShift :: !Int
+     , vecTail :: ![a]
+     , intVecPtrs :: !(Array (Vector_ a))
+     }
+  deriving Show
 
-instance (Eq a) => Eq (Vector a) where
+data Vector_ a
+  = InternalNode
+      { intVecPtrs_ :: !(Array (Vector_ a))
+      }
+  | DataNode
+      { dataVec :: !(Array a)
+      }
+  deriving Show
+
+instance Eq a => Eq (Vector a) where
   (==) = pvEq
 
-instance (Ord a) => Ord (Vector a) where
+instance Eq a => Eq (Vector_ a) where
+  (==) = pvEq_
+
+instance Ord a => Ord (Vector a) where
   compare = pvCompare
 
+instance Ord a => Ord (Vector_ a) where
+  compare = pvCompare_
+
 instance F.Foldable Vector where
+  foldMap = T.foldMapDefault
   foldr = foldr
+  foldl = foldl
+#if MIN_VERSION_base(4,6,0)
+  foldr' = foldr'
+  foldl' = foldl'
+#endif
+#if MIN_VERSION_base(4,8,0)
+  length = length
+  null = null
+#endif
 
 instance Functor Vector where
   fmap = map
 
-instance M.Monoid (Vector a) where
+instance Sem.Semigroup (Vector a) where
+  (<>) = append
+
+instance Monoid (Vector a) where
   mempty = empty
-  mappend = append
+  -- Defined for compatibility with ghc 8.2
+  mappend = (<>)
 
 instance T.Traversable Vector where
   traverse = pvTraverse
 
-instance (NFData a) => NFData (Vector a) where
+instance NFData a => NFData (Vector a) where
   rnf = pvRnf
 
-{-# INLINABLE pvEq #-}
--- | A dispatcher between various equality tests.  The length check is
--- extremely cheap.  There is another optimized check for the case
--- where neither input is sliced.  For sliced inputs, we currently
--- fall back to a list conversion.
-pvEq :: (Eq a) => Vector a -> Vector a -> Bool
-pvEq EmptyVector EmptyVector = True
-pvEq v1@RootNode { } v2@RootNode { }
-  | length v1 /= length v2 = False
-  | isNotSliced v1 && isNotSliced v2 = pvSimpleEq v1 v2
-  | otherwise = F.toList v1 == F.toList v2
-pvEq (DataNode a1) (DataNode a2) = a1 == a2
-pvEq (InternalNode a1) (InternalNode a2) = a1 == a2
-pvEq _ _ = False
+instance NFData a => NFData (Vector_ a) where
+  rnf = pvRnf_
 
--- | A simple equality implementation for unsliced vectors.  This can
--- proceed structurally.
-pvSimpleEq :: (Eq a) => Vector a -> Vector a -> Bool
-pvSimpleEq EmptyVector EmptyVector = True
-pvSimpleEq (RootNode sz1 sh1 _ _ t1 v1) (RootNode sz2 sh2 _ _ t2 v2) =
-  sz1 == sz2 && sh1 == sh2 && t1 == t2 && v1 == v2
-pvSimpleEq (DataNode a1) (DataNode a2) = a1 == a2
-pvSimpleEq (InternalNode a1) (InternalNode a2) = a1 == a2
-pvSimpleEq _ _ = False
+shiftR :: Int -> Int -> Int
+{-# INLINE shiftR #-}
+shiftR = unsafeShiftR
 
-{-# INLINABLE pvCompare #-}
--- | A dispatcher for comparison tests
-pvCompare :: (Ord a) => Vector a -> Vector a -> Ordering
-pvCompare EmptyVector EmptyVector = EQ
-pvCompare (DataNode a1) (DataNode a2) = compare a1 a2
-pvCompare (InternalNode a1) (InternalNode a2) = compare a1 a2
-pvCompare v1@RootNode { vecSize = s1 } v2@RootNode { vecSize = s2 }
-  | s1 /= s2 = compare s1 s2
-  | isNotSliced v1 && isNotSliced v2 = pvSimpleCompare v1 v2
-  | otherwise = compare (F.toList v1) (F.toList v2)
-pvCompare EmptyVector _ = LT
-pvCompare _ EmptyVector = GT
-pvCompare (DataNode _) (InternalNode _) = LT
-pvCompare (InternalNode _) (DataNode _) = GT
-pvCompare _ _ = error "Data.Vector.Persistent: unexpected root node"
+shiftL :: Int -> Int -> Int
+{-# INLINE shiftL #-}
+shiftL = unsafeShiftL
 
+{-# INLINABLE pvEq #-}
+pvEq :: Eq a => Vector a -> Vector a -> Bool
+pvEq (RootNode sz1 sh1 t1 v1) (RootNode sz2 sh2 t2 v2) =
+  sz1 == sz2 && (sz1 == 0 || (sh1 == sh2 && t1 == t2 && v1 == v2))
 
+{-# INLINABLE pvEq_ #-}
+pvEq_ :: Eq a => Vector_ a -> Vector_ a -> Bool
+pvEq_ (DataNode a1) (DataNode a2) = a1 == a2
+pvEq_ (InternalNode a1) (InternalNode a2) = a1 == a2
+pvEq_ _ _ = False
 
-pvSimpleCompare :: (Ord a) => Vector a -> Vector a -> Ordering
-pvSimpleCompare EmptyVector EmptyVector = EQ
-pvSimpleCompare (RootNode _ _ _ _ t1 v1) (RootNode _ _ _ _ t2 v2) =
-  case compare v1 v2 of
-    EQ -> compare t1 t2
-    o -> o
-pvSimpleCompare (DataNode a1) (DataNode a2) = compare a1 a2
-pvSimpleCompare (InternalNode a1) (InternalNode a2) = compare a1 a2
-pvSimpleCompare EmptyVector _ = LT
-pvSimpleCompare _ EmptyVector = GT
-pvSimpleCompare (InternalNode _) (DataNode _) = GT
-pvSimpleCompare (DataNode _) (InternalNode _) = LT
-pvSimpleCompare _ _ = error "Data.Vector.Persistent.pvSimpleCompare: Unexpected mismatch"
+{-# INLINABLE pvCompare #-}
+pvCompare :: Ord a => Vector a -> Vector a -> Ordering
+pvCompare (RootNode sz1 _ t1 v1) (RootNode sz2 _ t2 v2) =
+  compare sz1 sz2 <> if sz1 == 0 then EQ else compare v1 v2 <> compare t1 t2
 
+{-# INLINABLE pvCompare_ #-}
+pvCompare_ :: Ord a => Vector_ a -> Vector_ a -> Ordering
+pvCompare_ (DataNode a1) (DataNode a2) = compare a1 a2
+pvCompare_ (InternalNode a1) (InternalNode a2) = compare a1 a2
+pvCompare_ (DataNode _) (InternalNode _) = LT
+pvCompare_ (InternalNode _) (DataNode _) = GT
 
+
 {-# INLINABLE map #-}
--- | O(n) Map over the vector
+-- | \( O(n) \) Map over the vector
 map :: (a -> b) -> Vector a -> Vector b
 map f = go
   where
-    go EmptyVector = EmptyVector
-    go (DataNode v) = DataNode (A.map f v)
-    go (InternalNode v) = InternalNode (A.map (fmap f) v)
-    go (RootNode sz sh off cap t v) =
+    go (RootNode sz sh t v) =
       let t' = L.map f t
-          v' = A.map (fmap f) v
-      in RootNode sz sh off cap t' v'
+          v' = A.map go_ v
+      in RootNode sz sh t' v'
 
--- | A more strict 3 tuple for the folds
-data FoldInfo a = FI a !Int !Int
+    go_ (DataNode v) = DataNode (A.map f v)
+    go_ (InternalNode v) = InternalNode (A.map go_ v)
 
-{-# INLINABLE foldr #-}
--- | O(n) Right fold over the vector
+{-# INLINE foldr #-}
+-- | \( O(n) \) Right fold over the vector
 foldr :: (a -> b -> b) -> b -> Vector a -> b
-foldr _ s0 EmptyVector = s0
-foldr f s0 v
-  | isNotSliced v = sgo v s0
-  | otherwise =
-    case go v (FI s0 (max 0 (vecCapacity v - vecSize v)) (length v)) of (FI r _ _) -> r
+foldr f = go
   where
-    go EmptyVector seed = seed
-    go (DataNode a) s@(FI seed nskip len)
-      | len <= 0 = s
-      | nskip == 0 = FI (A.boundedFoldr f (32 - len) 32 seed a) 0 (len - A.length a)
-      | nskip >= 32 = FI seed (nskip - 32) len
-      | otherwise =
-        let end = min (max 0 (32 - nskip)) 32
-            start = 32 - (len + nskip)
-            taken = end - max 0 start
-        in FI (A.boundedFoldr f start end seed a) 0 (len - taken)
-    go (InternalNode as) seed =
-      A.foldr go seed as
-      -- Note: if there is a tail at all, the elements are live (slice
-      -- drops unused tail elements)
-    go (RootNode _ _ _ _ t as) (FI s nskip l) =
-      let tseed = L.foldl' (flip f) s t
-          seed = FI tseed nskip (l - L.length t)
-      in A.foldr go seed as
-
-    -- A simpler variant for unsliced vectors (the common case) that is
-    -- significantly more efficient
-    sgo EmptyVector seed = seed
-    sgo (DataNode a) seed = A.foldr f seed a
-    sgo (InternalNode as) seed = A.foldr sgo seed as
-    sgo (RootNode _ _ _ _ t as) seed =
-      let tseed = L.foldl' (flip f) seed t
-      in A.foldr sgo tseed as
+    go seed (RootNode _ _ t as) = {-# SCC "gorRootNode" #-}
+      let tseed = F.foldr f seed (L.reverse t)
+      in A.foldr go_ tseed as
+    go_ (DataNode a) seed = {-# SCC "gorDataNode" #-} A.foldr f seed a
+    go_ (InternalNode as) seed = {-# SCC "gorInternalNode" #-}
+      A.foldr go_ seed as
 
-{-# INLINABLE foldl' #-}
--- | O(n) Strict left fold over the vector
-foldl' :: (b -> a -> b) -> b -> Vector a -> b
-foldl' _ s0 EmptyVector = s0
-foldl' f s0 v
-  | isNotSliced v = sgo s0 v
-  | otherwise =
-    case go (FI s0 (vecOffset v) (length v)) v of (FI r _ _) -> r
+-- | \( O(n) \) Strict right fold over the vector.
+--
+-- Note: Strict in the initial accumulator value.
+foldr' :: (a -> b -> b) -> b -> Vector a -> b
+{-# INLINE foldr' #-}
+foldr' f = go
   where
-    go seed EmptyVector = seed
-    go s@(FI seed nskip len) (DataNode a)
-      | len <= 0 = s
-      | nskip == 0 = FI (A.boundedFoldl' f 0 (min len 32) seed a) 0 (len - A.length a)
-      | nskip >= 32 = FI seed (nskip - 32) len
-      | otherwise =
-        let end = min 32 (len + nskip)
-            start = nskip
-            taken = end - max 0 start
-        in FI (A.boundedFoldl' f start end seed a) 0 (len - taken)
-    go seed (InternalNode as) =
-      A.foldl' go seed as
-    go (FI s nskip l) (RootNode _ _ _ _ t as) =
-      let FI rseed _ _ = A.foldl' go (FI s nskip (l - L.length t)) as
-      in FI (L.foldr (flip f) rseed t) 0 0
+    go !seed (RootNode _ _ t as) = {-# SCC "gorRootNode" #-}
+      let !tseed = F.foldl' (flip f) seed t
+      in A.foldr' go_ tseed as
+    go_ (DataNode a) !seed = {-# SCC "gorDataNode" #-} A.foldr' f seed a
+    go_ (InternalNode as) !seed = {-# SCC "gorInternalNode" #-}
+      A.foldr' go_ seed as
 
-    sgo seed EmptyVector = seed
-    sgo seed (DataNode a) = A.foldl' f seed a
-    sgo seed (InternalNode as) =
-      A.foldl' sgo seed as
-    sgo seed (RootNode _ _ _ _ t as) =
-      let rseed = A.foldl' sgo seed as
+-- | \( O(n) \) Left fold over the vector.
+foldl :: (b -> a -> b) -> b -> Vector a -> b
+{-# INLINE foldl #-}
+foldl f = go
+  where
+    go seed (RootNode _ _ t as) =
+      let rseed = A.foldl go_ seed as
       in F.foldr (flip f) rseed t
 
-{-# INLINABLE pvTraverse #-}
-pvTraverse :: (Ap.Applicative f) => (a -> f b) -> Vector a -> f (Vector b)
+    go_ seed (DataNode a) = {-# SCC "golDataNode" #-} A.foldl f seed a
+    go_ seed (InternalNode as) =
+      A.foldl go_ seed as
+
+-- | \( O(n) \) Strict left fold over the vector.
+--
+-- Note: Strict in the initial accumulator value.
+foldl' :: (b -> a -> b) -> b -> Vector a -> b
+{-# INLINE foldl' #-}
+foldl' f = go
+  where
+    go !seed (RootNode _ _ t as) =
+      let !rseed = A.foldl' go_ seed as
+      in F.foldl' f rseed (L.reverse t)
+    go_ !seed (DataNode a) = {-# SCC "golDataNode" #-} A.foldl' f seed a
+    go_ !seed (InternalNode as) =
+      A.foldl' go_ seed as
+
+{-# INLINE pvTraverse #-}
+pvTraverse :: Ap.Applicative f => (a -> f b) -> Vector a -> f (Vector b)
 pvTraverse f = go
   where
-    go EmptyVector = Ap.pure EmptyVector
-    go (DataNode a) = DataNode Ap.<$> A.traverseArray f a
-    go (InternalNode as) = InternalNode Ap.<$> A.traverseArray go as
-    go (RootNode sz sh off cap t as) =
-      RootNode sz sh off cap Ap.<$> T.traverse f t Ap.<*> A.traverseArray go as
+    go (RootNode sz sh t as)
+      | sz == 0 = Ap.pure empty
+      | otherwise = Ap.liftA2 (\as' t' -> RootNode sz sh t' as') (A.traverseArray go_ as) (forwards $ T.traverse (Backwards . f) t)
+    go_ (DataNode a) = DataNode Ap.<$> A.traverseArray f a
+    go_ (InternalNode as) = InternalNode Ap.<$> A.traverseArray go_ as
 
-{-# INLINABLE append #-}
+-- | \( O(m) \) Append two 'Vector' instances
+--
+-- > append v1 v2
+--
+-- This operation is linear in the length of @v2@ (where @length v1 == n@ and @length v2 == m@).
 append :: Vector a -> Vector a -> Vector a
-append EmptyVector v = v
-append v EmptyVector = v
-append v1 v2 = foldl' snoc v1 v2
+append v1 v2
+  | null v1 = v2
+  | null v2 = v1
+append v1 v2 = F.foldl' snoc v1 v2
 
 {-# INLINABLE pvRnf #-}
-pvRnf :: (NFData a) => Vector a -> ()
-pvRnf = F.foldr deepseq ()
+pvRnf :: NFData a => Vector a -> ()
+pvRnf (RootNode _ _ t as) = rnf as `seq` rnf t
 
--- | O(1) The empty vector
+{-# INLINABLE pvRnf_ #-}
+pvRnf_ :: NFData a => Vector_ a -> ()
+pvRnf_ (DataNode a) = rnf a
+pvRnf_ (InternalNode a) = rnf a
+
+-- | \( O(1) \) The empty vector.
 empty :: Vector a
-empty = EmptyVector
+empty = RootNode 0 5 [] A.empty
 
--- | O(1) Test to see if the vector is empty.
+-- | \( O(1) \) Test to see if the vector is empty.
 null :: Vector a -> Bool
-null EmptyVector = True
-null _ = False
+null xs = length xs == 0
 
--- | O(1) Get the length of the vector.
+-- | \( O(1) \) Get the length of the vector.
 length :: Vector a -> Int
-length EmptyVector = 0
-length RootNode { vecSize = s, vecOffset = off } = s - off
-length InternalNode {} = error "Data.Vector.Persistent.length: Internal nodes should not be exposed"
-length DataNode {} = error "Data.Vector.Persistent.length: Data nodes should not be exposed"
+length RootNode { vecSize = s } = s
 
--- | O(1) Bounds-checked indexing into a vector.
+-- | \( O(1) \) Bounds-checked indexing into a vector.
 index :: Vector a -> Int -> Maybe a
 index v ix
-  | length v > ix = Just $ unsafeIndex v ix
+  -- Check if the index is valid. This funny business uses a single test to
+  -- determine whether ix is too small (negative) or too large (at least the
+  -- length of the vector).
+  | (fromIntegral ix :: Word) < fromIntegral (length v)
+  = unsafeIndexA v ix
   | otherwise = Nothing
 
--- | O(1) Unchecked indexing into a vector.
+-- Index into a list from the rear.
 --
--- Note that out-of-bounds indexing might not even crash - it will
+-- revIx# [1..3] 0 = (# 3 #)
+-- revIx# [1..3] 1 = (# 2 #)
+-- revIx# [1..3] 2 = (# 1 #)
+--
+-- This is the same as reversing the list and then indexing
+-- into it, but it doesn't need to allocate a reversed copy
+-- of the list.
+--
+-- TODO: produce an error if the index is too large, instead of
+-- just giving a wrong answer. This just requires a custom
+-- version of `drop`.
+revIx# :: [a] -> Int -> (# a #)
+revIx# xs i = go xs (L.drop (i + 1) xs)
+  where
+    go :: [a] -> [b] -> (# a #)
+    go (a : _) [] = (# a #)
+    go (_ : as) (_ : bs) = go as bs
+    go _ _ = error "revIx#: Whoopsy!"
+
+-- | \( O(1) \) Unchecked indexing into a vector.
+--
+-- Out-of-bounds indexing might not even crash—it will
 -- usually just return nonsense values.
+--
+-- Note: the actual lookup is not performed until the result is forced.
+-- This can cause a memory leak if the result of indexing is stored, unforced,
+-- after the rest of the vector becomes garbage. To avoid this, use
+-- 'unsafeIndexA' or 'unsafeIndex#' instead.
 unsafeIndex :: Vector a -> Int -> a
-unsafeIndex vec userIndex
-  | ix >= tailOffset vec && vecCapacity vec < vecSize vec =
-    L.reverse (vecTail vec) !! (ix .&. 0x1f)
+unsafeIndex vec ix
+  | (# a #) <- unsafeIndex# vec ix
+  = a
+
+-- | \( O(1) \) Unchecked indexing into a vector in the context of an arbitrary
+-- 'Ap.Applicative' functor. If the 'Ap.Applicative' is "strict" (such as 'IO',
+-- (strict) @ST s@, (strict) @StateT@, or 'Maybe', but not @Identity@,
+-- @ReaderT@, etc.), then the lookup is performed before the next action. This
+-- avoids space leaks that can result from lazy uses of 'unsafeIndex'. See the
+-- documentation for 'unsafeIndex#' for a custom 'Ap.Applicative' that can be
+-- especially useful in conjunction with this function.
+--
+-- Note that out-of-bounds indexing might not even crash—it will usually just
+-- return nonsense values.
+unsafeIndexA :: Ap.Applicative f => Vector a -> Int -> f a
+{-# INLINABLE unsafeIndexA #-}
+unsafeIndexA vec ix
+  | (# a #) <- unsafeIndex# vec ix
+  = Ap.pure a
+
+-- | \( O(1) \) Unchecked indexing into a vector.
+--
+-- Note that out-of-bounds indexing might not even crash—it will
+-- usually just return nonsense values.
+--
+-- This function exists mostly because there is not, as yet, a well-known,
+-- canonical, and convenient /lifted/ unary tuple. So we instead offer an
+-- eager indexing function returning an /unlifted/ unary tuple. Users who
+-- prefer to avoid such "low-level" features can do something like this:
+--
+-- @
+-- data Solo a = Solo a deriving Functor
+-- instance Applicative Solo where
+--   pure = Solo
+--   liftA2 f (Solo a) (Solo b) = Solo (f a b)
+-- @
+--
+-- Now
+--
+-- @
+-- unsafeIndexA :: Vector a -> Int -> Solo a
+-- @
+unsafeIndex# :: Vector a -> Int -> (# a #)
+unsafeIndex# vec ix
+  | ix >= tailOffset vec =
+    (vecTail vec) `revIx#` (ix .&. 0x1f)
   | otherwise =
       let sh = vecShift vec
       in go (sh - 5) (A.index (intVecPtrs vec) (ix `shiftR` sh))
   where
-    -- The user is indexing from zero but there could be some masked
-    -- portion of the vector due to the offset - we have to correct to
-    -- an internal offset
-    ix = vecOffset vec + userIndex
     go level v
-      | level == 0 = A.index (dataVec v) (ix .&. 0x1f)
+      | level == 0 = A.index# (dataVec v) (ix .&. 0x1f)
       | otherwise =
         let nextVecIx = (ix `shiftR` level) .&. 0x1f
-            v' = intVecPtrs v
+            v' = intVecPtrs_ v
         in go (level - 5) (A.index v' nextVecIx)
 
--- | O(1) Construct a vector with a single element.
+-- | \( O(1) \) Construct a vector with a single element.
 singleton :: a -> Vector a
 singleton elt =
   RootNode { vecSize = 1
            , vecShift = 5
-           , vecOffset = 0
-           , vecCapacity = 0
            , vecTail = [elt]
-           , intVecPtrs = A.fromList 0 []
+           , intVecPtrs = A.empty
            }
 
 -- | A helper to copy an array and add an element to the end.
 arraySnoc :: Array a -> a -> Array a
-arraySnoc a elt = A.run $ do
+arraySnoc !a elt = A.run $ do
   let alen = A.length a
   a' <- A.new_ (1 + alen)
   A.copy a 0 a' 0 alen
   A.write a' alen elt
   return a'
 
--- | O(1) Append an element to the end of the vector.
+-- | \( O(1) \) Append an element to the end of the vector.
 snoc :: Vector a -> a -> Vector a
-snoc EmptyVector elt = singleton elt
-snoc v@RootNode { vecSize = sz, vecShift = sh, vecOffset = off, vecTail = t } elt
-  -- In this case, we are operating on a slice that has free space at
-  -- the end inside of its tree.  Use 'update' to replace the formerly
-  -- unreachable element and then make it reachable.
-  | vecCapacity v >= sz =
-    let v' = v { vecSize = sz + 1 }
-    in update (sz - off) elt v'
+-- We break this up into two pieces. We let the common case inline:
+-- that is the case of a nonempty vector with room in its tail.
+-- The case of an empty vector isn't common enough to bother inlining,
+-- and the case of a full tail is expensive anyway, so there's nothing
+-- to be gained by inlining. The remaining question: do we actually
+-- benefit from letting *any* of this inline? To be determined, but my
+-- guess is a strong maybe.
+snoc v@RootNode { vecSize = sz, vecTail = t } elt
+  -- Room in tail, and vector non-empty
   | sz .&. 0x1f /= 0 = v { vecTail = elt : t, vecSize = sz + 1 }
+  | otherwise = snocMain v elt
+
+snocMain :: Vector a -> a -> Vector a
+{-# NOINLINE snocMain #-}
+snocMain v elt
+  | null v = singleton elt
+snocMain v@RootNode { vecSize = sz, vecShift = sh, vecTail = t } elt
   -- Overflow current root
   | sz `shiftR` 5 > 1 `shiftL` sh =
     RootNode { vecSize = sz + 1
              , vecShift = sh + 5
-             , vecOffset = vecOffset v
-             , vecCapacity = vecCapacity v + 32
              , vecTail = [elt]
-             , intVecPtrs = A.fromList 2 [ InternalNode (intVecPtrs v)
-                                         , newPath sh t
-                                         ]
+             , intVecPtrs =
+                 let !np = newPath sh t
+                 in A.fromList 2 [ InternalNode (intVecPtrs v)
+                                 , np
+                                 ]
              }
   -- Insert into the tree
   | otherwise =
       RootNode { vecSize = sz + 1
                , vecShift = sh
-               , vecOffset = vecOffset v
-               , vecCapacity = vecCapacity v + 32
                , vecTail = [elt]
                , intVecPtrs = pushTail sz t sh (intVecPtrs v)
                }
-snoc _ _ = error "Data.Vector.Persistent.snoc: Internal nodes should not be exposed to the user"
 
 -- | A recursive helper for 'snoc'.  This finds the place to add new
 -- elements.
-pushTail :: Int -> [a] -> Int -> Array (Vector a) -> Array (Vector a)
-pushTail cnt t = go
+pushTail :: Int -> [a] -> Int -> Array (Vector_ a) -> Array (Vector_ a)
+pushTail !cnt t !foo !bar = go foo bar
   where
-    go level parent
-      | level == 5 = arraySnoc parent (DataNode (A.fromList 32 (L.reverse t)))
+    go !level !parent
+      | level == 5 = arraySnoc parent $! DataNode (A.fromListRev 32 t)
       | subIdx < A.length parent =
         let nextVec = A.index parent subIdx
-            toInsert = go (level - 5) (intVecPtrs nextVec)
-        in A.update parent subIdx (InternalNode toInsert)
-      | otherwise = arraySnoc parent (newPath (level - 5) t)
+            toInsert = go (level - 5) (intVecPtrs_ nextVec)
+        in A.update parent subIdx $! InternalNode toInsert
+      | otherwise = arraySnoc parent $! newPath (level - 5) t
       where
         subIdx = ((cnt - 1) `shiftR` level) .&. 0x1f
 
 -- | The other recursive helper for 'snoc'.  This one builds out a
 -- sub-tree to the current depth.
-newPath :: Int -> [a] -> Vector a
+newPath :: Int -> [a] -> Vector_ a
 newPath level t
-  | level == 0 = DataNode (A.fromList 32 (L.reverse t))
-  | otherwise = InternalNode $ A.fromList 1 $ [newPath (level - 5) t]
+  | level == 0 = DataNode (A.fromListRev 32 t)
+  | otherwise = InternalNode $ A.singleton $! newPath (level - 5) t
 
--- | O(1) Update a single element at @ix@ with new value @elt@ in
--- @v@.
+-- | Update a single element at @ix@ with new value @elt@.
+updateList :: Int -> a -> [a] -> [a]
+-- We do this pretty strictly to avoid building up thunks in the tail
+-- and to release the replaced value promptly.
+updateList !_ _ [] = []
+updateList 0 x (_ : ys) = x : ys
+updateList n x (y : ys) = (y :) $! updateList (n - 1) x ys
+
+-- | \( O(1) \) Update a single element at @ix@ with new value @elt@ in @v@.
 --
 -- > update ix elt v
 update :: Int -> a -> Vector a -> Vector a
-update ix elt = (// [(ix, elt)])
-
--- | O(n) Bulk update.
---
--- > v // updates
---
--- For each (index, element) pair in @updates@, modify @v@ such that
--- the @index@th position of @v@ is @element@.
--- Indices in @updates@ that are not in @v@ are ignored
-(//) :: Vector a -> [(Int, a)] -> Vector a
-(//) = L.foldr replaceElement
-
-replaceElement :: (Int, a) -> Vector a -> Vector a
-replaceElement _ EmptyVector = EmptyVector
-replaceElement (userIndex, elt) v@(RootNode { vecSize = sz, vecShift = sh, vecTail = t })
-  -- Invalid index
-  | sz <= ix || ix < 0 = v
-  -- Item is in tail,
-  | ix >= toff && vecCapacity v < sz =
-    case t of
-      -- The tail can only be empty if this was a slice where the last
-      -- array in the tree is full and the slice left no tail.  This
-      -- is rare but we have to handle it.
-      [] -> v { vecTail = [elt] }
-      _ ->
-        let tix = sz - 1 - ix
-            (keepHead, _:keepTail) = L.splitAt tix t
-        in v { vecTail = keepHead ++ (elt : keepTail) }
+update ix elt v@(RootNode { vecSize = sz, vecShift = sh, vecTail = t })
+  -- Invalid index. This funny business uses a single test to determine whether
+  -- ix is too small (negative) or too large (at least sz).
+  | (fromIntegral ix :: Word) >= fromIntegral sz = v
+  -- Item is in tail
+  | ix >= tailOffset v =
+    let tix = sz - 1 - ix
+    in v { vecTail = updateList tix elt t}
   -- Otherwise the item to be replaced is in the tree
   | otherwise = v { intVecPtrs = go sh (intVecPtrs v) }
   where
-    ix = userIndex + vecOffset v
-    toff = tailOffset v
     go level vec
       -- At the data level, modify the vector and start propagating it up
       | level == 5 =
-        let dnode = DataNode $ A.update (dataVec vec') (ix .&. 0x1f) elt
+        let !dnode = DataNode $ A.update (dataVec vec') (ix .&. 0x1f) elt
         in A.update vec vix dnode
       -- In the tree, find the appropriate sub-array, call
       -- recursively, and re-allocate current array
       | otherwise =
-          let rnode = go (level - 5) (intVecPtrs vec')
+          let !rnode = go (level - 5) (intVecPtrs_ vec')
           in A.update vec vix (InternalNode rnode)
       where
         vix = (ix `shiftR` level) .&. 0x1f
         vec' = A.index vec vix
-replaceElement _ _ = error "Data.Vector.Persistent.replaceElement: should not see internal nodes"
 
--- | O(1) Return a slice of @v@ of length @length@ starting at index
--- @start@.  The returned vector may have fewer than @length@ elements
--- if the bounds are off on either side (the start is negative or
--- length takes it past the end).
---
--- A slice of negative or zero length is the empty vector.
+-- | \( O(n) \) Bulk update.
 --
--- > slice start length v
+-- > v // updates
 --
--- Note that a slice retains all of the references that the vector it
--- is derived from has.  They are not reachable via any traversals and
--- are not counted towards its size, but this may lead to references
--- living longer than intended.  If is important to you that this not
--- happen, call 'shrink' on the return value of 'slice' to drop unused
--- space and references.
-slice :: Int -> Int -> Vector a -> Vector a
-slice _ _ EmptyVector = EmptyVector
-slice start userLen v@RootNode { vecSize = sz, vecOffset = off, vecCapacity = cap, vecTail = t }
-  | len <= 0 = EmptyVector
-  -- All the retained data is in the tail, so zero everything else out
-  | toff < start =
-    let t' = L.reverse $ L.take userLen $ L.drop (start - toff) $ L.reverse t
-    in v { vecOffset = 0
-         , vecCapacity = 0
-         , intVecPtrs = A.fromList 0 []
-         , vecSize = L.length t'
-         , vecTail = t'
-         }
-  -- Start was negative, so we really start at zero and retain at most
-  -- (len + start) elements.  In this case vecOffset remains the same.
-  | start < 0 =
-    let eltsRetained = min (len + start) sz
-    in v { vecSize = eltsRetained
-         , vecTail = L.drop (sz - eltsRetained) t
-         }
-  -- If capacity < start, the tail needs to be modified from the front
-  -- in fact, max 0 (start - capacity) items need to be dropped from the
-  -- list
-  | otherwise =
-      let newOff = off + start
-          newSize = min (newOff + len) sz
-          ntake = max 0 (start - cap)
-          t' = L.drop (sz - newSize) t
-      in v { vecOffset = newOff
-           , vecSize = newSize
-           , vecTail = L.take (L.length t' - ntake) t'
-           }
+-- For each @(index, element)@ pair in @updates@, modify @v@ such that
+-- the @index@th position of @v@ is @element@.
+-- Indices in @updates@ that are not in @v@ are ignored. The updates are
+-- applied in order, so the last one at each index takes effegct.
+(//) :: Vector a -> [(Int, a)] -> Vector a
+-- Note: we fully apply foldl' to get everything to unbox.
+(//) vec = L.foldl' replaceElement vec
   where
-    toff = tailOffset v
-    len = max 0 (min userLen (sz - start))
-slice _ _ _ = error "Data.Vector.Persistent.slice: Internal node"
-
--- Note that slice removes unneeded elements from the tail so that
--- snoc can mostly work unchanged.  snoc does need to change if the
--- slice takes so many elements that parts of the tree contain
--- inaccessible elements.  In that case, just use update instead.
-
--- | O(1) Take the first @i@ elements of the vector.
---
--- Note that this is just a wrapper around slice and the resulting
--- slice retains references that are inaccessible.  Use 'shrink' if
--- this is undesirable.
-take :: Int -> Vector a -> Vector a
-take = slice 0
-
--- | O(1) Drop @i@ elements from the front of the vector.
---
--- Note that this is just a wrapper around slice.
-drop :: Int -> Vector a -> Vector a
-drop i v = slice i (length v) v
-
--- | O(1) Split the vector at the given position.
-splitAt :: Int -> Vector a -> (Vector a, Vector a)
-splitAt ix v = (take ix v, drop ix v)
+    replaceElement v (ix, a) = update ix a v
 
--- | O(n) Force a sliced vector to drop any unneeded space and
--- references.
+-- | The index of the first element of the tail of the vector (that is, the
+-- *last* element of the list representing the tail). This is also the number
+-- of elements stored in the array tree.
 --
--- This is a no-op for an un-sliced vector.
-shrink :: Vector a -> Vector a
-shrink EmptyVector = EmptyVector
-shrink v
-  | isNotSliced v = v
-  | otherwise = fromList $ F.toList v
+-- Caution: Only gives a sensible result if the vector is nonempty.
+tailOffset :: Vector a -> Int
+tailOffset v = (length v - 1) .&. ((-1) `shiftL` 5)
 
--- | O(n) Reverse a vector
+-- | \( O(n) \) Reverse a vector
 reverse :: Vector a -> Vector a
-reverse = fromList . foldl' (flip (:)) []
+{-# NOINLINE reverse #-}
+reverse = foldr' (flip snoc) empty
 
--- | O(n) Filter according to the predicate
+-- | \( O(n) \) Filter according to the predicate.
 filter :: (a -> Bool) -> Vector a -> Vector a
-filter p = foldl' go empty
+filter p = \ !vec -> foldl' go empty vec
   where
-    go acc e = if p e then snoc acc e else acc
+    go !acc e = if p e then snoc acc e else acc
 
--- | O(n) Return the elements that do and do not obey the predicate
+-- | \( O(n) \) Return the elements that do and do not obey the predicate
 partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)
-partition p = spToPair . foldl' go (SP empty empty)
+partition p v0 = case F.foldl' go (TwoVec empty empty) v0 of
+  TwoVec v1 v2 -> (v1, v2)
   where
-    go (SP atrue afalse) e =
-      if p e then SP (snoc atrue e) afalse else SP atrue (snoc afalse e)
+    go (TwoVec atrue afalse) e =
+      if p e then TwoVec (snoc atrue e) afalse else TwoVec atrue (snoc afalse e)
 
--- | O(n) Construct a vector from a list.
+data TwoVec a = TwoVec {-# UNPACK #-} !(Vector a) {-# UNPACK #-} !(Vector a)
+
+-- | \( O(n) \) Construct a vector from a list
 fromList :: [a] -> Vector a
 fromList = F.foldl' snoc empty
 
-data StrictPair a b = SP !a !b
-
-spSnd :: StrictPair a b -> b
-spSnd (SP _ v) = v
+-- | \( O(n) \) Take @n@ elements starting from the start of the 'Vector'
+take :: Int -> Vector a -> Vector a
+take n v = fromList (L.take n (F.toList v))
 
-spToPair :: StrictPair a b -> (a, b)
-spToPair (SP a b) = (a, b)
+-- | \( O(n) \) Drop @n@ elements starting from the start of the 'Vector'
+drop :: Int -> Vector a -> Vector a
+drop n v = fromList (L.drop n (F.toList v))
 
--- | O(n) Apply a predicate @p@ to the vector, returning the longest
--- prefix of elements that satisfy @p@.
-takeWhile :: (a -> Bool) -> Vector a -> Vector a
-takeWhile p = spSnd . foldl' f (SP True empty)
-  where
-    f (SP True v) e =
-      if p e then SP True (snoc v e)
-      else SP False v
-    f a _ = a
+-- | \( O(n) \) Split the vector into two at the given index
+--
+-- Note that this function strictly computes both result vectors (once the tuple
+-- itself is reduced to whnf)
+splitAt :: Int -> Vector a -> (Vector a, Vector a)
+splitAt idx v
+  | (front_list, rear_list) <- L.splitAt idx (F.toList v)
+  , !front <- fromList front_list
+  , !rear <- fromList rear_list
+  = (front, rear)
 
--- | O(n) Returns the longest suffix after @takeWhile p v@.
-dropWhile :: (a -> Bool) -> Vector a -> Vector a
-dropWhile p = spSnd . foldl' f (SP True empty)
-  where
-    f a@(SP True v) e =
-      if p e then a
-      else SP False (snoc v e)
-    f (SP False v) e = SP False (snoc v e)
+-- | \( O(n) \) Return a slice of @v@ of length @length@ starting at index
+-- @start@.  The returned vector may have fewer than @length@ elements
+-- if the bounds are off on either side (the start is negative or
+-- length takes it past the end).
+--
+-- A slice of negative or zero length is the empty vector.
+--
+-- > slice start length v
+slice :: Int -> Int -> Vector a -> Vector a
+slice start len v = fromList (L.take len (L.drop start (F.toList v)))
 
--- Helpers
+-- | \( O(1) \) Drop any unused space in the vector
+--
+-- NOTE: This is currently the identity
+shrink :: Vector a -> Vector a
+shrink = id
 
-tailOffset :: Vector a -> Int
-tailOffset EmptyVector = 0
-tailOffset v
-  | len < 32 = 0
-  | otherwise = (len - 1) `shiftR` 5 `shiftL` 5
-  where
-    len = vecSize v
+-- | \( O(n) \) Apply a predicate p to the vector, returning the longest prefix of elements that satisfy p.
+takeWhile :: (a -> Bool) -> Vector a -> Vector a
+takeWhile p = fromList . L.takeWhile p . F.toList
 
-isNotSliced :: Vector a -> Bool
-isNotSliced v = vecOffset v == 0 && vecCapacity v < vecSize v
+-- | \( O(n) \) Returns the longest suffix after takeWhile p v.
+dropWhile :: (a -> Bool) -> Vector a -> Vector a
+dropWhile p = fromList . L.dropWhile p . F.toList
diff --git a/src/Data/Vector/Persistent/Array.hs b/src/Data/Vector/Persistent/Array.hs
--- a/src/Data/Vector/Persistent/Array.hs
+++ b/src/Data/Vector/Persistent/Array.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
-{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
 -- |
 -- Module: Data.Vector.Persistent.Array
 -- Copyright: Johan Tibell <johan.tibell@gmail.com>
@@ -15,6 +15,7 @@
       -- * Creation
     , new
     , new_
+    , empty
     , singleton
     , singleton'
     , pair
@@ -25,6 +26,7 @@
     , read
     , write
     , index
+    , index#
     , index_
     , indexM_
     , update
@@ -44,9 +46,11 @@
     , copyM
 
       -- * Folds
+    , foldl
     , foldl'
     , boundedFoldl'
     , foldr
+    , foldr'
     , boundedFoldr
 
     , thaw
@@ -55,19 +59,21 @@
     , traverseArray
     , filter
     , fromList
+    , fromListRev
     , toList
     ) where
 
 import qualified Data.Traversable as Traversable
 import qualified Control.Applicative as A
 import Control.DeepSeq
-import Control.Monad.ST hiding (runST)
+import Control.Monad.ST
 import qualified GHC.Exts as Ext
 import GHC.ST (ST(..))
-import Prelude hiding (filter, foldr, length, map, read)
-import qualified Prelude as P
-
-import Data.Vector.Persistent.Unsafe (runST)
+import Prelude hiding (filter, foldl, foldr, length, map, read)
+import qualified Data.Foldable as F
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid (mappend)
+#endif
 
 ------------------------------------------------------------------------
 
@@ -79,11 +85,13 @@
 # define CHECK_OP(_func_,_op_,_lhs_,_rhs_) \
 if not ((_lhs_) _op_ (_rhs_)) then error ("Data.HashMap.Array." ++ (_func_) ++ ": Check failed: _lhs_ _op_ _rhs_ (" ++ show (_lhs_) ++ " vs. " ++ show (_rhs_) ++ ")") else
 # define CHECK_GT(_func_,_lhs_,_rhs_) CHECK_OP(_func_,>,_lhs_,_rhs_)
+# define CHECK_GE(_func_,_lhs_,_rhs_) CHECK_OP(_func_,>=,_lhs_,_rhs_)
 # define CHECK_LE(_func_,_lhs_,_rhs_) CHECK_OP(_func_,<=,_lhs_,_rhs_)
 #else
 # define CHECK_BOUNDS(_func_,_len_,_k_)
 # define CHECK_OP(_func_,_op_,_lhs_,_rhs_)
 # define CHECK_GT(_func_,_lhs_,_rhs_)
+# define CHECK_GE(_func_,_lhs_,_rhs_)
 # define CHECK_LE(_func_,_lhs_,_rhs_)
 #endif
 
@@ -103,23 +111,15 @@
 instance Ord a => Ord (Array a) where
   compare = arrayCompare
 
-arrayEq :: (Eq a) => Array a -> Array a -> Bool
-arrayEq a1 a2
-  | length a1 /= length a2 = False
-  | otherwise = P.foldr (\i a -> a && index a1 i == index a2 i) True [0..(length a1 - 1)]
+arrayEq :: Eq a => Array a -> Array a -> Bool
+{-# INLINABLE arrayEq #-}
+arrayEq a1 a2 = length a1 == length a2 &&
+  F.all (\i -> index a1 i == index a2 i) [0..(length a1 - 1)]
 
-arrayCompare :: (Ord a) => Array a -> Array a -> Ordering
-arrayCompare a1 a2
-  | length a1 < length a2 = LT
-  | length a1 > length a2 = GT
-  | otherwise = go EQ (length a1)
-  where
-    go GT _ = GT
-    go LT _ = LT
-    go EQ ix =
-      case ix < 0 of
-        True -> EQ
-        False -> go (compare (index a1 ix) (index a2 ix)) (ix - 1)
+arrayCompare :: Ord a => Array a -> Array a -> Ordering
+{-# INLINABLE arrayCompare #-}
+arrayCompare a1 a2 = compare (length a1) (length a2) `mappend`
+  F.foldMap (\i -> index a1 i `compare` index a2 i) [0..(length a1 - 1)]
 
 #if __GLASGOW_HASKELL__ >= 702
 length :: Array a -> Int
@@ -177,7 +177,7 @@
 -- value.
 new :: Int -> a -> ST s (MArray s a)
 new n@(Ext.I# n#) b =
-    CHECK_GT("new",n,(0 :: Int))
+    CHECK_GE("new",n,(0 :: Int))
     ST $ \s ->
         case Ext.newArray# n# b s of
             (# s', ary #) -> (# s', marray ary n #)
@@ -186,6 +186,13 @@
 new_ :: Int -> ST s (MArray s a)
 new_ n = new n undefinedElem
 
+-- The globally shared empty array. There's no point
+-- allocating a new empty array every time we need one
+-- when we can just follow a pointer to get one.
+empty :: Array a
+empty = runST (new_ 0 >>= unsafeFreeze)
+{-# NOINLINE empty #-}
+
 singleton :: a -> Array a
 singleton x = runST (singleton' x)
 {-# INLINE singleton #-}
@@ -220,6 +227,12 @@
         case Ext.indexArray# (unArray ary) i# of (# b #) -> b
 {-# INLINE index #-}
 
+index# :: Array a -> Int -> (# a #)
+index# ary _i@(Ext.I# i#) =
+    CHECK_BOUNDS("index", length ary, _i)
+        Ext.indexArray# (unArray ary) i#
+{-# INLINE index# #-}
+
 index_ :: Array a -> Int -> ST s a
 index_ ary _i@(Ext.I# i#) =
     CHECK_BOUNDS("index_", length ary, _i)
@@ -350,38 +363,63 @@
            return ()
 {-# INLINE unsafeUpdate' #-}
 
+-- | Note: strict in the initial accumulator value.
 foldl' :: (b -> a -> b) -> b -> Array a -> b
-foldl' f z0 ary0 = go ary0 (length ary0) 0 z0
+foldl' f !z0 !ary0 = go ary0 (length ary0) 0 z0
   where
-    go ary n i !z
+    go !ary n !i !z
         | i >= n    = z
-        | otherwise = go ary n (i+1) (f z (index ary i))
+        | (# x #) <- index# ary i
+        = go ary n (i+1) (f z x)
 {-# INLINE foldl' #-}
 
+foldl :: (b -> a -> b) -> b -> Array a -> b
+foldl f z0 !ary0 = go ary0 (length ary0) z0
+  where
+    go !ary !i z
+        | i == 0    = z
+        | (# x #) <- index# ary (i - 1)
+        = f (go ary (i-1) z) x
+{-# INLINE foldl #-}
+
 boundedFoldl' :: (b -> a -> b) -> Int -> Int -> b -> Array a -> b
-boundedFoldl' f start end z0 ary0 =
+boundedFoldl' f !start !end z0 ary0 =
   go ary0 (min end (length ary0)) (max 0 start) z0
   where
     go ary n i !z
       | i >= n = z
-      | otherwise = go ary n (i+1) (f z (index ary i))
+      | (# x #) <- index# ary i
+      = go ary n (i+1) (f z x)
 {-# INLINE boundedFoldl' #-}
 
 foldr :: (a -> b -> b) -> b -> Array a -> b
-foldr f z0 ary0 = go ary0 (length ary0) 0 z0
+foldr f z0 !ary0 = go ary0 (length ary0) 0 z0
+-- foldr f = \ z0 ary0 -> go ary0 (length ary0) 0 z0
   where
-    go ary n i z
+    go !ary !n !i z
         | i >= n    = z
-        | otherwise = f (index ary i) (go ary n (i+1) z)
+        | (# x #) <- index# ary i
+        = f x (go ary n (i+1) z)
 {-# INLINE foldr #-}
 
+-- | Note: Strict in the initial accumulator value.
+foldr' :: (a -> b -> b) -> b -> Array a -> b
+foldr' f !z0 !ary0 = go ary0 (length ary0) z0
+  where
+    go !ary !i !z
+        | i == 0 = z
+        | (# x #) <- index# ary (i - 1)
+        = go ary (i-1) (f x z)
+{-# INLINE foldr' #-}
+
 boundedFoldr :: (a -> b -> b) -> Int -> Int -> b -> Array a -> b
-boundedFoldr f start end z0 ary0 =
+boundedFoldr f !start !end z0 !ary0 =
   go ary0 (min end (length ary0)) (max 0 start) z0
   where
-    go ary n i z
+    go !ary !n !i z
       | i >= n = z
-      | otherwise = f (index ary i) (go ary n (i+1) z)
+      | (# x #) <- index# ary i
+      = f x (go ary n (i+1) z)
 {-# INLINE boundedFoldr #-}
 
 undefinedElem :: a
@@ -455,8 +493,17 @@
     go xs0 mary 0
   where
     go [] !mary !_   = return mary
-    go (x:xs) mary i = do write mary i x
-                          go xs mary (i+1)
+    go (x:xs) !mary !i = do write mary i x
+                            go xs mary (i+1)
+
+fromListRev :: Int -> [a] -> Array a
+fromListRev n xs0 = run $ do
+    mary <- new_ n
+    go xs0 mary (n - 1)
+  where
+    go [] !mary !_   = return mary
+    go (x:xs) !mary !i = do write mary i x
+                            go xs mary (i-1)
 
 toList :: Array a -> [a]
 toList = foldr (:) []
diff --git a/src/Data/Vector/Persistent/Unsafe.hs b/src/Data/Vector/Persistent/Unsafe.hs
deleted file mode 100644
--- a/src/Data/Vector/Persistent/Unsafe.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples #-}
-
--- | This module exports a workaround for this bug:
---
---    http://hackage.haskell.org/trac/ghc/ticket/5916
---
--- Please read the comments in ghc/libraries/base/GHC/ST.lhs to
--- understand what's going on here.
---
--- Code that uses this module should be compiled with -fno-full-laziness
-module Data.Vector.Persistent.Unsafe
-    ( runST
-    ) where
-
-import GHC.Base (realWorld#)
-import GHC.ST hiding (runST, runSTRep)
-
--- | Return the value computed by a state transformer computation.
--- The @forall@ ensures that the internal state used by the 'ST'
--- computation is inaccessible to the rest of the program.
-runST :: (forall s. ST s a) -> a
-runST st = runSTRep (case st of { ST st_rep -> st_rep })
-{-# INLINE runST #-}
-
-runSTRep :: (forall s. STRep s a) -> a
-runSTRep st_rep = case st_rep realWorld# of
-                        (# _, r #) -> r
-{-# INLINE [0] runSTRep #-}
diff --git a/tests/pvTests.hs b/tests/pvTests.hs
--- a/tests/pvTests.hs
+++ b/tests/pvTests.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Main ( main ) where
 
 import Test.Framework ( defaultMain, Test )
@@ -5,8 +6,12 @@
 import Test.QuickCheck
 
 import qualified Data.Foldable as F
-import Data.Monoid
+import qualified Data.Monoid as DM
 import qualified Data.List as L
+import qualified Control.Applicative as Ap
+import qualified Data.Traversable as T
+
+--import Data.Vector.Persistent ( Vector )
 import qualified Data.Vector.Persistent as V
 
 newtype InputList = InputList [Int]
@@ -14,57 +19,45 @@
 instance Arbitrary InputList where
   arbitrary = sized inputList
 
-data IndexableList = IndexableList [Int] Int
-                   deriving (Show)
-
-instance Arbitrary IndexableList where
-  arbitrary = sized indexableList
-
-data SliceList = SliceList [Int] Int Int
-               deriving (Show)
-instance Arbitrary SliceList where
-  arbitrary = sized sliceList
+data SizedList = SizedList [Int] !Int
+  deriving Show
 
-sliceList :: Int -> Gen SliceList
-sliceList sz = do
-  modifier <- choose (0, 100)
-  l <- vector (1 + (sz * modifier))
-  start <- choose (0, length l - 1)
-  len <- choose (0, 100)
-  return $ SliceList l start len
+instance Arbitrary SizedList where
+  arbitrary = sized sizedList
 
-indexableList :: Int -> Gen IndexableList
-indexableList sz = do
-  modifier <- choose (0, 100)
-  l <- vector (1 + (sz * modifier))
-  ix <- choose (0, length l - 1)
-  return $ IndexableList l ix
+sizedList :: Int -> Gen SizedList
+sizedList sz = do
+  len <- chooseInt (0, sz)
+  lst <- vector len
+  return $ SizedList lst len
 
 inputList :: Int -> Gen InputList
 inputList sz = do
-  modifier <- choose (0, 100)
-  l <- vector (sz * modifier)
-  return $ InputList l
+  len <- chooseInt (0, max 1 sz)
+  InputList Ap.<$> vector len
 
 tests :: [Test]
 tests = [ testProperty "toListFromListIdent" prop_toListFromListIdentity
         , testProperty "fmap" prop_map
         , testProperty "foldrWorks" prop_foldrWorks
         , testProperty "foldlWorks" prop_foldlWorks
+        , testProperty "traverseWorks" prop_traverseWorks
         , testProperty "updateWorks" prop_updateWorks
         , testProperty "indexingWorks" prop_indexingWorks
-        , testProperty "take" prop_take
-        , testProperty "drop" prop_drop
-        , testProperty "splitAt" prop_splitAt
-        , testProperty "slice" prop_slice
-        , testProperty "slicedFoldl'" prop_slicedFoldl'
-        , testProperty "slicedFoldr" prop_sliceFoldr
         , testProperty "mappendWorks" prop_mappendWorks
+        , testProperty "eqWorksEqual" prop_eqWorks_equal
+        , testProperty "eqWorks" prop_eqWorks
         , testProperty "shrink" prop_shrinkPreserves
         , testProperty "shrinkEq" prop_shrinkEquality
         , testProperty "appendAfterSlice" prop_appendAfterSlice
         , testProperty "takeWhile" prop_takeWhile
         , testProperty "dropWhile" prop_dropWhile
+        , testProperty "take" prop_take
+        , testProperty "drop" prop_drop
+        , testProperty "splitAt" prop_splitAt
+        , testProperty "slice" prop_slice
+        , testProperty "slicedFoldl'" prop_slicedFoldl'
+        , testProperty "slicedFoldr" prop_sliceFoldr
         ]
 
 main :: IO ()
@@ -86,7 +79,7 @@
 
 prop_foldlWorks :: InputList -> Bool
 prop_foldlWorks (InputList il) =
-  F.foldl' (flip (:)) [] il == V.foldl' (flip (:)) [] (V.fromList il)
+  F.foldl (flip (:)) [] il == F.foldl (flip (:)) [] (V.fromList il)
 
 prop_updateWorks :: (InputList, Int, Int) -> Property
 prop_updateWorks (InputList il, ix, repl) =
@@ -100,26 +93,60 @@
         True -> il
         False -> keepHead ++ (repl : keepTail)
 
-prop_indexingWorks :: IndexableList -> Bool
-prop_indexingWorks (IndexableList il ix) =
-  (il !! ix) == (V.unsafeIndex (V.fromList il) ix)
+prop_indexingWorks :: SizedList -> Bool
+prop_indexingWorks (SizedList il sz) =
+  il == [V.unsafeIndex vec ix | ix <- [0..sz - 1]]
+  where
+    vec = V.fromList il
 
-prop_take :: IndexableList -> Bool
-prop_take (IndexableList il ix) =
+prop_mappendWorks :: (InputList, InputList) -> Bool
+prop_mappendWorks (InputList il1, InputList il2) =
+  (il1 `DM.mappend` il2) == F.toList (V.fromList il1 `DM.mappend` V.fromList il2)
+
+prop_eqWorks_equal :: InputList -> Bool
+prop_eqWorks_equal (InputList il) =
+  V.fromList il == V.fromList il
+
+prop_eqWorks :: InputList -> InputList -> Bool
+prop_eqWorks (InputList il1) (InputList il2) =
+  (V.fromList il1 == V.fromList il2) == (il1 == il2)
+
+prop_traverseWorks :: InputList -> Bool
+prop_traverseWorks (InputList il) =
+  fmap F.toList (T.traverse go (V.fromList il)) == T.traverse go il
+  where
+    go a = ([a], a)
+
+prop_take :: SizedList -> Bool
+prop_take (SizedList il ix) =
   L.take ix il == F.toList (V.take ix (V.fromList il))
 
-prop_drop :: IndexableList -> Bool
-prop_drop (IndexableList il ix) =
+prop_drop :: SizedList -> Bool
+prop_drop (SizedList il ix) =
   L.drop ix il == F.toList (V.drop ix (V.fromList il))
 
-prop_splitAt :: IndexableList -> Bool
-prop_splitAt (IndexableList il ix) =
+prop_splitAt :: SizedList -> Bool
+prop_splitAt (SizedList il ix) =
   let (v1, v2) = V.splitAt ix (V.fromList il)
   in L.splitAt ix il == (F.toList v1, F.toList v2)
 
 listSlice :: Int -> Int -> [a] -> [a]
 listSlice s n = L.take n . (L.drop s)
 
+data SliceList = SliceList [Int] !Int !Int
+               deriving (Show)
+
+instance Arbitrary SliceList where
+  arbitrary = sized sliceList
+
+sliceList :: Int -> Gen SliceList
+sliceList sz = do
+  modifier <- choose (0, 100)
+  l <- vector (1 + (sz * modifier))
+  start <- choose (0, length l - 1)
+  len <- choose (0, 100)
+  return $ SliceList l start len
+
 prop_slice :: SliceList -> Bool
 prop_slice (SliceList il s n) =
   listSlice s n il == F.toList (V.slice s n (V.fromList il))
@@ -132,10 +159,6 @@
 prop_slicedFoldl' (SliceList il s n) =
   L.foldl' (flip (:)) [] (listSlice s n il) == V.foldl' (flip (:)) [] (V.slice s n (V.fromList il))
 
-prop_mappendWorks :: (InputList, InputList) -> Bool
-prop_mappendWorks (InputList il1, InputList il2) =
-  (il1 `mappend` il2) == F.toList (V.fromList il1 `mappend` V.fromList il2)
-
 prop_shrinkPreserves :: SliceList -> Bool
 prop_shrinkPreserves (SliceList il s n) =
   F.toList v0 == F.toList (V.shrink v0)
@@ -155,14 +178,14 @@
     v0 = V.slice s n (V.fromList il)
     v1 = V.snoc v0 elt
 
-prop_takeWhile :: IndexableList -> Bool
-prop_takeWhile (IndexableList il ix) =
+prop_takeWhile :: SizedList -> Bool
+prop_takeWhile (SizedList il ix) =
   L.takeWhile (<ix) il == F.toList v
   where
     v = V.takeWhile (<ix) $ V.fromList il
 
-prop_dropWhile :: IndexableList -> Bool
-prop_dropWhile (IndexableList il ix) =
+prop_dropWhile :: SizedList -> Bool
+prop_dropWhile (SizedList il ix) =
   L.dropWhile (<ix) il == F.toList v
   where
     v = V.dropWhile (<ix) $ V.fromList il