diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012, Tristan Ravitch
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tristan Ravitch nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,67 @@
+# Persistent Vector
+
+A library providing persistent (purely functional) vectors for Haskell
+based on array mapped tries.
+
+## Description
+
+These persistent vectors are modeled on the persistent vector used by
+clojure, with an API modeled after Data.Sequence from the containers
+library.  This data structure is *spine strict* and is not useful for
+incremental consumption.  If you need that, stick to lists.  It is
+still lazy in the elements.
+
+While per-element operations are O(log(n)), the internal tree can
+never be more than 7 or 8 deep.  Thus, they are effectively constant
+time.
+
+This implementation adds O(1) slicing support for vectors that I do
+not believe clojure supports.  The implementation cheats, though, and
+slices can retain references to objects that cannot be indexed.
+
+## Performance
+
+Performance is an important consideration for a data structure like
+this.  The package contains a criterion benchmark suite that attempts
+to compare the performance of persistent vectors against a variety of
+existing persistent data structures.  As an overview of the results I
+have observed:
+
+ * Traversing and building lists is faster than the same operations
+   with persistent vectors.
+
+ * (Strict) left folds over persistent vectors are faster than left
+   folds over Sequences.  Right folds over Sequences are faster than
+   right folds over vectors.
+
+ * Indexing persistent vectors is faster than indexing sequences and
+   IntMaps (and, of course, lists).
+
+ * Appending to vectors is slightly faster than appending to a Sequence.
+   It is much faster than appending to an IntMap.
+
+ * Updating an element at an index in a vector is *slower* than
+   updating an index in a Sequence (but still faster than an IntMap).
+
+Overall, it seems like persistent vectors are efficient at most tasks.
+If you only need a (strict) left fold, they are efficient for
+traversal.  Indexing and construction are very fast, but Sequences are
+superior for element-wise updates.
+
+## Implementation
+
+## TODO
+
+ * More of the Data.Sequence API
+
+ * More efficient Eq and Ord instances.  This is tricky in the
+   presence of slicing.  There are faster implementations for unsliced
+   inputs.
+
+ * Implement something to make parallel reductions simple (maybe
+   something like vector-strategies)
+
+ * Implement cons.  Cons can use the space that is hidden by the
+   offset cheaply.  It can also make a variant of pushTail
+   (pushHead) that allocates fragments of preceeding sub-trees.
+   Each cons call will modify the offset of its result vector.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bench/pvBench.hs b/bench/pvBench.hs
new file mode 100644
--- /dev/null
+++ b/bench/pvBench.hs
@@ -0,0 +1,166 @@
+module Main ( main ) where
+
+import Criterion.Config
+import Criterion.Main
+
+import Control.DeepSeq
+import qualified Data.Foldable as F
+import Data.IntMap ( IntMap )
+import qualified Data.IntMap as IM
+import qualified Data.List as L
+import Data.Sequence ( Seq )
+import qualified Data.Sequence as S
+import Data.Vector.Persistent ( Vector )
+import qualified Data.Vector.Persistent as V
+
+testListRTraversal :: [Int] -> Int
+testListRTraversal = L.foldr (+) 0
+
+testListLSTraversal :: [Int] -> Int
+testListLSTraversal = L.foldl' (+) 0
+
+testVecRTraversal :: Vector Int -> Int
+testVecRTraversal = V.foldr (+) 0
+
+testIMRTraversal :: IntMap Int -> Int
+testIMRTraversal = F.foldr (+) 0
+
+testVecLTraversal :: Vector Int -> Int
+testVecLTraversal = V.foldl' (+) 0
+
+testSeqRTraversal :: Seq Int -> Int
+testSeqRTraversal = F.foldr (+) 0
+
+testSeqLTraversal :: Seq Int -> Int
+testSeqLTraversal = F.foldl (+) 0
+
+testVecLSTraversal :: Vector Int -> Int
+testVecLSTraversal = V.foldl' (+) 0
+
+testSeqLSTraversal :: Seq Int -> Int
+testSeqLSTraversal = F.foldl' (+) 0
+
+testListIndex :: [Int] -> Int -> Int
+testListIndex = (!!)
+
+testSeqIndex :: Seq Int -> Int -> Int
+testSeqIndex = S.index
+
+testVecIndex :: Vector Int -> Int -> Int
+testVecIndex = V.unsafeIndex
+
+testIMIndex :: IntMap Int -> Int -> Maybe Int
+testIMIndex = flip IM.lookup
+
+testSeqRange :: Seq Int -> Int -> Int -> Int
+testSeqRange s start end = sum $ map (S.index s) [start..end]
+
+testVecRange :: Vector Int -> Int -> Int -> Int
+testVecRange v start end = sum $ map (V.unsafeIndex v) [start..end]
+
+testIMAppend :: IntMap Int -> Int -> Int -> IntMap Int
+testIMAppend im ix i = IM.insert ix i im
+
+testSeqAppend :: Seq Int -> Int -> Seq Int
+testSeqAppend = (S.|>)
+
+testVecAppend :: Vector Int -> Int -> Vector Int
+testVecAppend = V.snoc
+
+testIMUpdate :: IntMap Int -> Int -> Int -> IntMap Int
+testIMUpdate m ix elt = IM.insert ix elt m
+
+testSeqUpdate :: Seq Int -> Int -> Int -> Seq Int
+testSeqUpdate s ix elt = S.update ix elt s
+
+testVecUpdate :: Vector Int -> Int -> Int -> Vector Int
+testVecUpdate v ix elt = V.update ix elt v
+
+testIMBuild :: Int -> IntMap Int
+testIMBuild len =
+  let l = [0..len]
+  in L.foldl' (\m (ix, elt) -> IM.insert ix elt m) IM.empty (zip l l)
+
+testSeqBuild :: Int -> Seq Int
+testSeqBuild len = L.foldl' (S.|>) S.empty [0..len]
+
+testVecBuild :: Int -> Vector Int
+testVecBuild len = L.foldl' V.snoc V.empty [0..len]
+
+main :: IO ()
+main = defaultMainWith defaultConfig setup [
+  bgroup "traverse1000" [ bench "ListR1000" $ whnf testListRTraversal l1000
+                        , bench "IMR1000" $ whnf testIMRTraversal im1000
+                        , bench "SeqR1000" $ whnf testSeqRTraversal s1000
+                        , bench "VecR1000" $ whnf testVecRTraversal v1000
+                        , bench "SeqL1000" $ whnf testSeqLTraversal s1000
+                        , bench "VecL1000" $ whnf testVecLTraversal v1000
+                        , bench "ListLS1000" $ whnf testListLSTraversal l1000
+                        , bench "SeqLS1000" $ whnf testSeqLSTraversal s1000
+                        , bench "VecLS1000" $ whnf testVecLSTraversal v1000
+                        ],
+  bgroup "indexAt3_1000" [ bench "List1000" $ whnf (testListIndex l1000) 3
+                         , bench "IM1000" $ whnf (testIMIndex im1000) 3
+                         , bench "Seq1000" $ whnf (testSeqIndex s1000) 3
+                         , bench "Vec1000" $ whnf (testVecIndex v1000) 3
+                         ],
+  bgroup "indexAt30_1000" [ bench "List1000" $ whnf (testListIndex l1000) 30
+                          , bench "IM1000" $ whnf (testIMIndex im1000) 30
+                          , bench "Seq1000" $ whnf (testSeqIndex s1000) 30
+                          , bench "Vec1000" $ whnf (testVecIndex v1000) 30
+                          ],
+  bgroup "indexAt30_10000" [ bench "Seq10000" $ whnf (testSeqIndex s10000) 30
+                           , bench "Vec10000" $ whnf (testVecIndex v10000) 30
+                           ],
+  bgroup "indexAt3000_10000" [ bench "IM1000" $ whnf (testIMIndex im10000) 3000
+                             , bench "Seq10000" $ whnf (testSeqIndex s10000) 3000
+                             , bench "Vec10000" $ whnf (testVecIndex v10000) 3000
+                             ],
+  bgroup "indexRange501-550_10000" [ bench "Seq10000" $ whnf (testSeqRange s10000 501) 550
+                                   , bench "Vec10000" $ whnf (testVecRange v10000 501) 550
+                                   ],
+  bgroup "indexRange5001-5500_100000" [ bench "Seq10000" $ whnf (testSeqRange s100000 5001) 5500
+                                      , bench "Vec10000" $ whnf (testVecRange v100000 5001) 5500
+                                      ],
+  bgroup "appendValue1000" [ bench "IM1000" $ whnf (testIMAppend im1000 1000) 1
+                           , bench "Seq1000" $ whnf (testSeqAppend s1000) 1
+                           , bench "Vec1000" $ whnf (testVecAppend v1000) 1
+                           ],
+  bgroup "appendValue100000" [ bench "IM100000" $ whnf (testIMAppend im100000 100000) 1
+                             , bench "Seq100000" $ whnf (testSeqAppend s100000) 1
+                             , bench "Vec100000" $ whnf (testVecAppend v100000) 1
+                             ],
+  bgroup "updateIndex5_1000" [ bench "IM1000" $ whnf (testIMUpdate im1000 5) 342
+                             , bench "Seq1000" $ whnf (testSeqUpdate s1000 5) 342
+                             , bench "Vec1000" $ whnf (testVecUpdate v1000 5) 342
+                             ],
+  bgroup "updateIndex5000_100000" [ bench "IM100000" $ whnf (testIMUpdate im100000 5000) 342
+                                  , bench "Seq100000" $ whnf (testSeqUpdate s100000 5000) 342
+                                  , bench "Vec100000" $ whnf (testVecUpdate v100000 5000) 342
+                                  ],
+  bgroup "build1000" [ bench "IM1000" $ whnf testIMBuild 1000
+                     , bench "Seq1000" $ whnf testSeqBuild 1000
+                     , bench "Vec1000" $ whnf testVecBuild 1000
+                     ]
+  ]
+  where
+    setup = do
+      l1000 `deepseq` l10000 `deepseq` l10000 `deepseq`
+        v1000 `deepseq` v10000 `deepseq` v100000 `deepseq`
+        im1000 `deepseq` im10000 `deepseq` im100000 `deepseq` return ()
+      S.sort s1000 `seq` S.sort s10000 `seq` S.sort s100000 `seq` return ()
+    l1000 :: [Int]
+    l1000 = [0..1000]
+    l10000 :: [Int]
+    l10000 = [0..10000]
+    l100000 :: [Int]
+    l100000 = [0..100000]
+    v1000 = V.fromList l1000
+    v10000 = V.fromList l10000
+    v100000 = V.fromList l100000
+    s1000 = S.fromList l1000
+    s10000 = S.fromList l10000
+    s100000 = S.fromList l100000
+    im1000 = IM.fromList (zip l1000 l1000)
+    im10000 = IM.fromList (zip l10000 l10000)
+    im100000 = IM.fromList (zip l100000 l100000)
diff --git a/persistent-vector.cabal b/persistent-vector.cabal
new file mode 100644
--- /dev/null
+++ b/persistent-vector.cabal
@@ -0,0 +1,69 @@
+name: persistent-vector
+version: 0.1.0.0
+synopsis: A persistent sequence based on array mapped tries
+license: BSD3
+license-file: LICENSE
+author: Tristan Ravitch
+maintainer: travitch@cs.wisc.edu
+category: Data
+build-type: Simple
+cabal-version: >=1.10
+extra-source-files: README.md
+
+description:
+  This package provides persistent vectors based on array mapped
+  tries.  The implementation is based on the persistent vectors used
+  in clojure, but in a Haskell-style API.  The API is modeled after
+  Data.Sequence from the containers library.
+  .
+  Technically, the element-wise operations are O(log(n)), but the
+  underlying tree cannot be more than 7 or 8 levels deep so this is
+  effectively constant time.
+  .
+  One change from the clojure implementation is that this version supports
+  O(1) slicing, though it does cheat a little.  Slices retain references
+  to elements that cannot be indexed.  These extra references (and the space
+  they occupy) can be reclaimed by 'shrink'ing the slice.  This seems like
+  a reasonable tradeoff, and, I believe, mirrors the behavior of the vector
+  library.
+  .
+  Highlights:
+  .
+    * O(1) append element, indexing, updates, length, and slicing
+  .
+    * Reasonably compact representation
+
+library
+  default-language: Haskell2010
+  exposed-modules: Data.Vector.Persistent
+  other-modules: Data.Vector.Persistent.Array
+                 Data.Vector.Persistent.Unsafe
+  build-depends: base ==4.5.*, deepseq
+  hs-source-dirs: src
+  ghc-options: -Wall
+  ghc-prof-options: -auto-all
+
+test-suite pvTests
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  main-is: pvTests.hs
+  hs-source-dirs: tests
+  ghc-options: -Wall
+  build-depends: persistent-vector,
+                 base == 4.*,
+                 QuickCheck > 2.4,
+                 test-framework,
+                 test-framework-quickcheck2
+
+benchmark pvBench
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  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,
+                 deepseq
diff --git a/src/Data/Vector/Persistent.hs b/src/Data/Vector/Persistent.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Vector/Persistent.hs
@@ -0,0 +1,519 @@
+-- | This is a port of the persistent vector from clojure to Haskell.
+-- It is spine-strict and lazy in the elements.
+--
+-- The implementation is based on array mapped tries.  The complexity
+-- 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.
+module Data.Vector.Persistent (
+  Vector,
+  -- * Construction
+  empty,
+  singleton,
+  snoc,
+  fromList,
+  -- * Queries
+  null,
+  length,
+  -- * Indexing
+  index,
+  unsafeIndex,
+  take,
+  drop,
+  splitAt,
+  -- * Slicing
+  slice,
+  shrink,
+  -- * Modification
+  update,
+  (//),
+  -- * Folds
+  foldr,
+  foldl',
+  -- * Transformations
+  map,
+  reverse,
+  -- * Searches
+  filter,
+  partition
+  ) where
+
+import Prelude hiding ( null, length, tail, take,
+                        drop, map, foldr, reverse,
+                        splitAt, filter
+                      )
+
+import Control.Applicative hiding ( empty )
+import Control.DeepSeq
+import Data.Bits
+import Data.Foldable ( Foldable )
+import qualified Data.Foldable as F
+import qualified Data.List as L
+import Data.Monoid ( Monoid )
+import qualified Data.Monoid as M
+import Data.Traversable ( Traversable )
+import qualified Data.Traversable as T
+
+import Data.Vector.Persistent.Array ( Array )
+import qualified Data.Vector.Persistent.Array as A
+
+-- 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 :: !(Array (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
+  compare = pvCompare
+
+instance Foldable Vector where
+  foldr = foldr
+
+instance Functor Vector where
+  fmap = map
+
+instance Monoid (Vector a) where
+  mempty = empty
+  mappend = append
+
+instance Traversable Vector where
+  traverse = pvTraverse
+
+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 v1 v2
+  | length v1 /= length v2 = False
+  | isNotSliced v1 && isNotSliced v2 = pvSimpleEq v1 v2
+  | otherwise = F.toList v1 == F.toList v2
+
+-- | 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
+
+{-# INLINABLE pvCompare #-}
+-- | A dispatcher for comparison tests
+pvCompare :: (Ord a) => Vector a -> Vector a -> Ordering
+pvCompare v1 v2
+  | length v1 /= length v2 = compare (length v1) (length v2)
+  | isNotSliced v1 && isNotSliced v2 = pvSimpleCompare v1 v2
+  | otherwise = compare (F.toList v1) (F.toList v2)
+
+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 map #-}
+-- | 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) =
+      let t' = L.map f t
+          v' = A.map (fmap f) v
+      in RootNode sz sh off cap t' v'
+
+{-# INLINABLE 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 (s0, max 0 (vecCapacity v - vecSize v), length v) of (r, _, _) -> r
+  where
+    go EmptyVector seed = seed
+    go (DataNode a) (seed, nskip, len)
+      | len <= 0 = (seed, 0, 0)
+      | nskip == 0 = (A.boundedFoldr f (32 - len) 32 seed a, 0, len - A.length a)
+      | nskip >= 32 = (seed, nskip - 32, len)
+      | otherwise =
+        let end = min (max 0 (32 - nskip)) 32
+            start = 32 - (len + nskip)
+            taken = end - max 0 start
+        in (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) (s, nskip, l) =
+      let tseed = L.foldl' (flip f) s t
+          seed = (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
+
+{-# 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 (s0, vecOffset v, length v) v of (r, _, _) -> r
+  where
+    go seed EmptyVector = seed
+    go (seed, nskip, len) (DataNode a)
+      | len <= 0 = (seed, 0, 0)
+      | nskip == 0 = (A.boundedFoldl' f 0 (min len 32) seed a, 0, len - A.length a)
+      | nskip >= 32 = (seed, nskip - 32, len)
+      | otherwise =
+        let end = min 32 (len + nskip)
+            start = nskip
+            taken = end - max 0 start
+        in (A.boundedFoldl' f start end seed a, 0, len - taken)
+    go seed (InternalNode as) =
+      A.foldl' go seed as
+    go (s, nskip, l) (RootNode _ _ _ _ t as) =
+      let (rseed, _, _) = A.foldl' go (s, nskip, l - L.length t) as
+      in (L.foldr (flip f) rseed t, 0, 0)
+
+    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
+      in F.foldr (flip f) rseed t
+
+{-# INLINABLE pvTraverse #-}
+pvTraverse :: (Applicative f) => (a -> f b) -> Vector a -> f (Vector b)
+pvTraverse f = go
+  where
+    go EmptyVector = pure EmptyVector
+    go (DataNode a) = DataNode <$> A.traverse f a
+    go (InternalNode as) = InternalNode <$> A.traverse go as
+    go (RootNode sz sh off cap t as) =
+      RootNode sz sh off cap <$> T.traverse f t <*> A.traverse go as
+
+{-# INLINABLE append #-}
+append :: Vector a -> Vector a -> Vector a
+append EmptyVector v = v
+append v EmptyVector = v
+append v1 v2 = F.foldl' snoc v1 (F.toList v2)
+
+{-# INLINABLE pvRnf #-}
+pvRnf :: (NFData a) => Vector a -> ()
+pvRnf = F.foldr deepseq ()
+
+-- | O(1) The empty vector
+empty :: Vector a
+empty = EmptyVector
+
+-- | O(1) Test to see if the vector is empty.
+null :: Vector a -> Bool
+null EmptyVector = True
+null _ = False
+
+-- | 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"
+
+-- | O(1) Bounds-checked indexing into a vector.
+index :: Vector a -> Int -> Maybe a
+index v ix
+  | length v > ix = Just $ unsafeIndex v ix
+  | otherwise = Nothing
+
+-- | O(1) Unchecked indexing into a vector.
+--
+-- Note that out-of-bounds indexing might not even crash - it will
+-- usually just return nonsense values.
+unsafeIndex :: Vector a -> Int -> a
+unsafeIndex vec userIndex
+  | ix >= tailOffset vec && vecCapacity vec < vecSize vec =
+    L.reverse (vecTail vec) !! (ix .&. 0x1f)
+  | otherwise = go (vecShift vec) vec
+  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)
+      | otherwise =
+        let nextVecIx = (ix `shiftR` level) .&. 0x1f
+            v' = intVecPtrs v
+        in go (level - 5) (A.index v' nextVecIx)
+
+-- | 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 []
+           }
+
+-- | 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
+  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.
+snoc :: Vector a -> a -> Vector a
+snoc EmptyVector elt = singleton elt
+snoc v@RootNode { vecSize = sz, vecShift = sh, 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' = update sz elt v
+    in v' { vecSize = vecSize v' + 1 }
+  -- Room in tail
+  | sz .&. 0x1f /= 0 = v { vecTail = elt : t, vecSize = sz + 1 }
+  -- 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
+                                         ]
+             }
+  -- 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
+  where
+    go level parent
+      | level == 5 = arraySnoc parent (DataNode (A.fromList 32 (L.reverse 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)
+      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 level t
+  | level == 0 = DataNode (A.fromList 32 (L.reverse t))
+  | otherwise = InternalNode $ A.fromList 1 $ [newPath (level - 5) t]
+
+-- | 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 =
+    let tix = sz - 1 - ix
+        (keepHead, _:keepTail) = L.splitAt tix t
+    in v { vecTail = keepHead ++ (elt : keepTail) }
+  -- 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
+        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')
+          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.
+--
+-- > slice start length v
+--
+-- 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
+  -- 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'
+           }
+  where
+    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)
+
+-- | O(n) Force a sliced vector to drop any unneeded space and
+-- references.
+--
+-- 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
+
+-- | O(n) Reverse a vector
+reverse :: Vector a -> Vector a
+reverse = fromList . foldl' (flip (:)) []
+
+-- | O(n) Filter according to the predicate
+filter :: (a -> Bool) -> Vector a -> Vector a
+filter p = foldl' go empty
+  where
+    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
+partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)
+partition p = foldl' go (empty, empty)
+  where
+    go (atrue, afalse) e =
+      if p e then (snoc atrue e, afalse) else (atrue, snoc afalse e)
+
+-- | O(n) Construct a vector from a list.
+fromList :: [a] -> Vector a
+fromList = F.foldl' snoc empty
+
+-- Helpers
+
+tailOffset :: Vector a -> Int
+tailOffset v
+  | len < 32 = 0
+  | otherwise = (len - 1) `shiftR` 5 `shiftL` 5
+  where
+    len = length v
+
+isNotSliced :: Vector a -> Bool
+isNotSliced v = vecOffset v == 0 && vecCapacity v < vecSize v
diff --git a/src/Data/Vector/Persistent/Array.hs b/src/Data/Vector/Persistent/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Vector/Persistent/Array.hs
@@ -0,0 +1,481 @@
+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
+{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
+
+-- | Zero based arrays.
+--
+-- Note that no bounds checking are performed.
+module Data.Vector.Persistent.Array
+    ( Array
+    , MArray
+
+      -- * Creation
+    , new
+    , new_
+    , singleton
+    , singleton'
+    , pair
+
+      -- * Basic interface
+    , length
+    , lengthM
+    , read
+    , write
+    , index
+    , index_
+    , indexM_
+    , update
+    , update'
+    , updateWith
+    , unsafeUpdate'
+    , insert
+    , insert'
+    , delete
+    , delete'
+
+    , unsafeFreeze
+    , unsafeThaw
+    , run
+    , run2
+    , copy
+    , copyM
+
+      -- * Folds
+    , foldl'
+    , boundedFoldl'
+    , foldr
+    , boundedFoldr
+
+    , thaw
+    , map
+    , map'
+    , traverse
+    , filter
+    , fromList
+    , toList
+    ) where
+
+import qualified Data.Traversable as Traversable
+import Control.Applicative (Applicative)
+import Control.DeepSeq
+import Control.Monad.ST hiding (runST)
+import GHC.Exts
+import GHC.ST (ST(..))
+import Prelude hiding (filter, foldr, length, map, read)
+import qualified Prelude as P
+
+import Data.Vector.Persistent.Unsafe (runST)
+
+------------------------------------------------------------------------
+
+#if defined(ASSERTS)
+-- This fugly hack is brought by GHC's apparent reluctance to deal
+-- with MagicHash and UnboxedTuples when inferring types. Eek!
+# define CHECK_BOUNDS(_func_,_len_,_k_) \
+if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.HashMap.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
+# 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_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_LE(_func_,_lhs_,_rhs_)
+#endif
+
+data Array a = Array {
+      unArray :: !(Array# a)
+#if __GLASGOW_HASKELL__ < 702
+    , length :: !Int
+#endif
+    }
+
+instance Show a => Show (Array a) where
+    show = show . toList
+
+instance Eq a => Eq (Array a) where
+  (==) = arrayEq
+
+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)]
+
+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)
+
+#if __GLASGOW_HASKELL__ >= 702
+length :: Array a -> Int
+length ary = I# (sizeofArray# (unArray ary))
+{-# INLINE length #-}
+#endif
+
+-- | Smart constructor
+array :: Array# a -> Int -> Array a
+#if __GLASGOW_HASKELL__ >= 702
+array ary _n = Array ary
+#else
+array = Array
+#endif
+{-# INLINE array #-}
+
+data MArray s a = MArray {
+      unMArray :: !(MutableArray# s a)
+#if __GLASGOW_HASKELL__ < 702
+    , lengthM :: !Int
+#endif
+    }
+
+#if __GLASGOW_HASKELL__ >= 702
+lengthM :: MArray s a -> Int
+lengthM mary = I# (sizeofMutableArray# (unMArray mary))
+{-# INLINE lengthM #-}
+#endif
+
+-- | Smart constructor
+marray :: MutableArray# s a -> Int -> MArray s a
+#if __GLASGOW_HASKELL__ >= 702
+marray mary _n = MArray mary
+#else
+marray = MArray
+#endif
+{-# INLINE marray #-}
+
+------------------------------------------------------------------------
+
+instance NFData a => NFData (Array a) where
+    rnf = rnfArray
+
+rnfArray :: NFData a => Array a -> ()
+rnfArray ary0 = go ary0 n0 0
+  where
+    n0 = length ary0
+    go !ary !n !i
+        | i >= n = ()
+        | otherwise = rnf (index ary i) `seq` go ary n (i+1)
+{-# INLINE rnfArray #-}
+
+-- | Create a new mutable array of specified size, in the specified
+-- state thread, with each element containing the specified initial
+-- value.
+new :: Int -> a -> ST s (MArray s a)
+new n@(I# n#) b =
+    CHECK_GT("new",n,(0 :: Int))
+    ST $ \s ->
+        case newArray# n# b s of
+            (# s', ary #) -> (# s', marray ary n #)
+{-# INLINE new #-}
+
+new_ :: Int -> ST s (MArray s a)
+new_ n = new n undefinedElem
+
+singleton :: a -> Array a
+singleton x = runST (singleton' x)
+{-# INLINE singleton #-}
+
+singleton' :: a -> ST s (Array a)
+singleton' x = new 1 x >>= unsafeFreeze
+{-# INLINE singleton' #-}
+
+pair :: a -> a -> Array a
+pair x y = run $ do
+    ary <- new 2 x
+    write ary 1 y
+    return ary
+{-# INLINE pair #-}
+
+read :: MArray s a -> Int -> ST s a
+read ary _i@(I# i#) = ST $ \ s ->
+    CHECK_BOUNDS("read", lengthM ary, _i)
+        readArray# (unMArray ary) i# s
+{-# INLINE read #-}
+
+write :: MArray s a -> Int -> a -> ST s ()
+write ary _i@(I# i#) b = ST $ \ s ->
+    CHECK_BOUNDS("write", lengthM ary, _i)
+        case writeArray# (unMArray ary) i# b s of
+            s' -> (# s' , () #)
+{-# INLINE write #-}
+
+index :: Array a -> Int -> a
+index ary _i@(I# i#) =
+    CHECK_BOUNDS("index", length ary, _i)
+        case indexArray# (unArray ary) i# of (# b #) -> b
+{-# INLINE index #-}
+
+index_ :: Array a -> Int -> ST s a
+index_ ary _i@(I# i#) =
+    CHECK_BOUNDS("index_", length ary, _i)
+        case indexArray# (unArray ary) i# of (# b #) -> return b
+{-# INLINE index_ #-}
+
+indexM_ :: MArray s a -> Int -> ST s a
+indexM_ ary _i@(I# i#) =
+    CHECK_BOUNDS("index_", lengthM ary, _i)
+        ST $ \ s# -> readArray# (unMArray ary) i# s#
+{-# INLINE indexM_ #-}
+
+unsafeFreeze :: MArray s a -> ST s (Array a)
+unsafeFreeze mary
+    = ST $ \s -> case unsafeFreezeArray# (unMArray mary) s of
+                   (# s', ary #) -> (# s', array ary (lengthM mary) #)
+{-# INLINE unsafeFreeze #-}
+
+unsafeThaw :: Array a -> ST s (MArray s a)
+unsafeThaw ary
+    = ST $ \s -> case unsafeThawArray# (unArray ary) s of
+                   (# s', mary #) -> (# s', marray mary (length ary) #)
+{-# INLINE unsafeThaw #-}
+
+run :: (forall s . ST s (MArray s e)) -> Array e
+run act = runST $ act >>= unsafeFreeze
+{-# INLINE run #-}
+
+run2 :: (forall s. ST s (MArray s e, a)) -> (Array e, a)
+run2 k = runST (do
+                 (marr,b) <- k
+                 arr <- unsafeFreeze marr
+                 return (arr,b))
+
+-- | Unsafely copy the elements of an array. Array bounds are not checked.
+copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
+#if __GLASGOW_HASKELL__ >= 702
+copy !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
+    CHECK_LE("copy", _sidx + _n, length src)
+    CHECK_LE("copy", _didx + _n, lengthM dst)
+        ST $ \ s# ->
+        case copyArray# (unArray src) sidx# (unMArray dst) didx# n# s# of
+            s2 -> (# s2, () #)
+#else
+copy !src !sidx !dst !didx n =
+    CHECK_LE("copy", sidx + n, length src)
+    CHECK_LE("copy", didx + n, lengthM dst)
+        copy_loop sidx didx 0
+  where
+    copy_loop !i !j !c
+        | c >= n = return ()
+        | otherwise = do b <- index_ src i
+                         write dst j b
+                         copy_loop (i+1) (j+1) (c+1)
+#endif
+
+-- | Unsafely copy the elements of an array. Array bounds are not checked.
+copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
+#if __GLASGOW_HASKELL__ >= 702
+copyM !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =
+    CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)
+    CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)
+    ST $ \ s# ->
+    case copyMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of
+        s2 -> (# s2, () #)
+#else
+copyM !src !sidx !dst !didx n =
+    CHECK_BOUNDS("copyM: src", lengthM src, sidx + n - 1)
+    CHECK_BOUNDS("copyM: dst", lengthM dst, didx + n - 1)
+    copy_loop sidx didx 0
+  where
+    copy_loop !i !j !c
+        | c >= n = return ()
+        | otherwise = do b <- indexM_ src i
+                         write dst j b
+                         copy_loop (i+1) (j+1) (c+1)
+#endif
+
+-- | /O(n)/ Insert an element at the given position in this array,
+-- increasing its size by one.
+insert :: Array e -> Int -> e -> Array e
+insert ary idx b = runST (insert' ary idx b)
+{-# INLINE insert #-}
+
+-- | /O(n)/ Insert an element at the given position in this array,
+-- increasing its size by one.
+insert' :: Array e -> Int -> e -> ST s (Array e)
+insert' ary idx b =
+    CHECK_BOUNDS("insert'", count + 1, idx)
+        do mary <- new_ (count+1)
+           copy ary 0 mary 0 idx
+           write mary idx b
+           copy ary idx mary (idx+1) (count-idx)
+           unsafeFreeze mary
+  where !count = length ary
+{-# INLINE insert' #-}
+
+-- | /O(n)/ Update the element at the given position in this array.
+update :: Array e -> Int -> e -> Array e
+update ary idx b = runST (update' ary idx b)
+{-# INLINE update #-}
+
+-- | /O(n)/ Update the element at the given position in this array.
+update' :: Array e -> Int -> e -> ST s (Array e)
+update' ary idx b =
+    CHECK_BOUNDS("update'", count, idx)
+        do mary <- thaw ary 0 count
+           write mary idx b
+           unsafeFreeze mary
+  where !count = length ary
+{-# INLINE update' #-}
+
+-- | /O(n)/ Update the element at the given positio in this array, by
+-- applying a function to it.  Evaluates the element to WHNF before
+-- inserting it into the array.
+updateWith :: Array e -> Int -> (e -> e) -> Array e
+updateWith ary idx f = update ary idx $! f (index ary idx)
+{-# INLINE updateWith #-}
+
+-- | /O(1)/ Update the element at the given position in this array,
+-- without copying.
+unsafeUpdate' :: Array e -> Int -> e -> ST s ()
+unsafeUpdate' ary idx b =
+    CHECK_BOUNDS("unsafeUpdate'", length ary, idx)
+        do mary <- unsafeThaw ary
+           write mary idx b
+           _ <- unsafeFreeze mary
+           return ()
+{-# INLINE unsafeUpdate' #-}
+
+foldl' :: (b -> a -> b) -> b -> Array a -> b
+foldl' f z0 ary0 = go ary0 (length ary0) 0 z0
+  where
+    go ary n i !z
+        | i >= n    = z
+        | otherwise = go ary n (i+1) (f z (index ary i))
+{-# INLINE foldl' #-}
+
+boundedFoldl' :: (b -> a -> b) -> Int -> Int -> b -> Array a -> b
+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))
+{-# INLINE boundedFoldl' #-}
+
+foldr :: (a -> b -> b) -> b -> Array a -> b
+foldr f z0 ary0 = go ary0 (length ary0) 0 z0
+  where
+    go ary n i z
+        | i >= n    = z
+        | otherwise = f (index ary i) (go ary n (i+1) z)
+{-# INLINE foldr #-}
+
+boundedFoldr :: (a -> b -> b) -> Int -> Int -> b -> Array a -> b
+boundedFoldr 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 = f (index ary i) (go ary n (i+1) z)
+{-# INLINE boundedFoldr #-}
+
+undefinedElem :: a
+undefinedElem = error "Data.HashMap.Array: Undefined element"
+{-# NOINLINE undefinedElem #-}
+
+thaw :: Array e -> Int -> Int -> ST s (MArray s e)
+#if __GLASGOW_HASKELL__ >= 702
+thaw !ary !_o@(I# o#) !n@(I# n#) =
+    CHECK_LE("thaw", _o + n, length ary)
+        ST $ \ s -> case thawArray# (unArray ary) o# n# s of
+            (# s2, mary# #) -> (# s2, marray mary# n #)
+#else
+thaw !ary !o !n =
+    CHECK_LE("thaw", o + n, length ary)
+        do mary <- new_ n
+           copy ary o mary 0 n
+           return mary
+#endif
+{-# INLINE thaw #-}
+
+-- | /O(n)/ Delete an element at the given position in this array,
+-- decreasing its size by one.
+delete :: Array e -> Int -> Array e
+delete ary idx = runST (delete' ary idx)
+{-# INLINE delete #-}
+
+-- | /O(n)/ Delete an element at the given position in this array,
+-- decreasing its size by one.
+delete' :: Array e -> Int -> ST s (Array e)
+delete' ary idx = do
+    mary <- new_ (count-1)
+    copy ary 0 mary 0 idx
+    copy ary (idx+1) mary idx (count-(idx+1))
+    unsafeFreeze mary
+  where !count = length ary
+{-# INLINE delete' #-}
+
+map :: (a -> b) -> Array a -> Array b
+map f = \ ary ->
+    let !n = length ary
+    in run $ do
+        mary <- new_ n
+        go ary mary 0 n
+  where
+    go ary mary i n
+        | i >= n    = return mary
+        | otherwise = do
+             write mary i $ f (index ary i)
+             go ary mary (i+1) n
+{-# INLINE map #-}
+
+-- | Strict version of 'map'.
+map' :: (a -> b) -> Array a -> Array b
+map' f = \ ary ->
+    let !n = length ary
+    in run $ do
+        mary <- new_ n
+        go ary mary 0 n
+  where
+    go ary mary i n
+        | i >= n    = return mary
+        | otherwise = do
+             write mary i $! f (index ary i)
+             go ary mary (i+1) n
+{-# INLINE map' #-}
+
+fromList :: Int -> [a] -> Array a
+fromList n xs0 = run $ do
+    mary <- new_ n
+    go xs0 mary 0
+  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 (:) []
+
+traverse :: Applicative f => (a -> f b) -> Array a -> f (Array b)
+traverse f = \ ary -> fromList (length ary) `fmap`
+                      Traversable.traverse f (toList ary)
+{-# INLINE traverse #-}
+
+filter :: (a -> Bool) -> Array a -> Array a
+filter p = \ ary ->
+    let !n = length ary
+    in run $ do
+        mary <- new_ n
+        go ary mary 0 0 n
+  where
+    go ary mary i j n
+        | i >= n    = if i == j
+                      then return mary
+                      else do mary2 <- new_ j
+                              copyM mary 0 mary2 0 j
+                              return mary2
+        | p el      = write mary j el >> go ary mary (i+1) (j+1) n
+        | otherwise = go ary mary (i+1) j n
+      where el = index ary i
+{-# INLINE filter #-}
diff --git a/src/Data/Vector/Persistent/Unsafe.hs b/src/Data/Vector/Persistent/Unsafe.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Vector/Persistent/Unsafe.hs
@@ -0,0 +1,28 @@
+{-# 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
new file mode 100644
--- /dev/null
+++ b/tests/pvTests.hs
@@ -0,0 +1,149 @@
+module Main ( main ) where
+
+import Test.Framework ( defaultMain, Test )
+import Test.Framework.Providers.QuickCheck2 ( testProperty )
+import Test.QuickCheck
+
+import qualified Data.Foldable as F
+import Data.Monoid
+import qualified Data.List as L
+import qualified Data.Traversable as T
+
+import Data.Vector.Persistent ( Vector )
+import qualified Data.Vector.Persistent as V
+
+newtype InputList = InputList [Int]
+                  deriving (Show)
+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
+
+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
+
+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
+
+inputList :: Int -> Gen InputList
+inputList sz = do
+  modifier <- choose (0, 100)
+  l <- vector (sz * modifier)
+  return $ InputList l
+
+tests :: [Test]
+tests = [ testProperty "toListFromListIdent" prop_toListFromListIdentity
+        , testProperty "fmap" prop_map
+        , testProperty "foldrWorks" prop_foldrWorks
+        , testProperty "foldlWorks" prop_foldlWorks
+        , 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 "shrink" prop_shrinkPreserves
+        , testProperty "shrinkEq" prop_shrinkEquality
+        ]
+
+main :: IO ()
+main = defaultMain tests
+
+prop_toListFromListIdentity :: InputList -> Bool
+prop_toListFromListIdentity (InputList il) =
+  il == F.toList (V.fromList il)
+
+prop_map :: InputList -> Bool
+prop_map (InputList il) =
+  L.map f il == F.toList (fmap f (V.fromList il))
+  where
+    f = (+20)
+
+prop_foldrWorks :: InputList -> Bool
+prop_foldrWorks (InputList il) =
+  F.foldr (+) 0 il == F.foldr (+) 0 (V.fromList il)
+
+prop_foldlWorks :: InputList -> Bool
+prop_foldlWorks (InputList il) =
+  F.foldl' (flip (:)) [] il == V.foldl' (flip (:)) [] (V.fromList il)
+
+prop_updateWorks :: (InputList, Int, Int) -> Property
+prop_updateWorks (InputList il, ix, repl) =
+  ix >= 0 ==> rlist == F.toList (v V.// [(ix, repl)])
+  where
+    v = V.fromList il
+    (keepHead, _:keepTail) = L.splitAt ix il
+    rlist = case null il of
+      True -> []
+      False -> case ix >= length il of
+        True -> il
+        False -> keepHead ++ (repl : keepTail)
+
+prop_indexingWorks :: IndexableList -> Bool
+prop_indexingWorks (IndexableList il ix) =
+  (il !! ix) == (V.unsafeIndex (V.fromList il) ix)
+
+prop_take :: IndexableList -> Bool
+prop_take (IndexableList il ix) =
+  L.take ix il == F.toList (V.take ix (V.fromList il))
+
+prop_drop :: IndexableList -> Bool
+prop_drop (IndexableList il ix) =
+  L.drop ix il == F.toList (V.drop ix (V.fromList il))
+
+prop_splitAt :: IndexableList -> Bool
+prop_splitAt (IndexableList 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)
+
+prop_slice :: SliceList -> Bool
+prop_slice (SliceList il s n) =
+  listSlice s n il == F.toList (V.slice s n (V.fromList il))
+
+prop_sliceFoldr :: SliceList -> Bool
+prop_sliceFoldr (SliceList il s n) =
+  L.foldr (:) [] (listSlice s n il) == V.foldr (:) [] (V.slice s n (V.fromList il))
+
+prop_slicedFoldl' :: SliceList -> Bool
+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)
+  where
+    v0 = V.slice s n (V.fromList il)
+
+prop_shrinkEquality :: SliceList -> Bool
+prop_shrinkEquality (SliceList il s n) =
+  v0 == V.shrink v0
+  where
+    v0 = V.slice s n (V.fromList il)