diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+# 0.1.0.0
+
+* Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+BSD 3-Clause License
+
+Copyright (c) 2022, Brian Shu
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the copyright holder nor the names of its
+   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 HOLDER 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,10 @@
+![Haskell](https://img.shields.io/badge/Haskell-5e5086?style=for-the-badge&logo=haskell&logoColor=white)
+![Hackage](https://img.shields.io/hackage/v/pvector?color=5e5184&style=for-the-badge)
+![GitHub Workflow Status](https://img.shields.io/github/workflow/status/oberblastmeister/pvector/Haskell-CI?style=for-the-badge)
+
+# pvector
+
+An implementation of persistent vectors, an efficient sequence data structure.
+It supports fast indexing, iteration, and snocing.
+
+For more information, see [`pvector` on Hackage](https://hackage.haskell.org/package/pvector).
diff --git a/bench/Main.hs b/bench/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/Main.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE PackageImports #-}
+
+module Main where
+
+import Control.DeepSeq (NFData)
+import Criterion.Main
+import Data.Foldable (foldl')
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List as List
+import Data.Maybe (fromJust)
+import qualified Data.RRBVector as RRBVector
+import qualified Data.Sequence as Seq
+import qualified Data.Vector as VB
+import qualified "persistent-vector" Data.Vector.Persistent as Vector.Persistent.Other
+import qualified "pvector" Data.Vector.Persistent as Vector.Persistent
+import qualified "pvector" Data.Vector.Persistent.Internal as Vector.Persistent.Internal
+import GHC.Exts (IsList (..))
+
+data Snocer where
+  Snocer :: NFData (f Int) => String -> ([Int] -> f Int) -> (f Int -> Int -> f Int) -> Snocer
+
+data FromList where
+  FromList :: String -> ([Int] -> f Int) -> FromList
+
+data Map where
+  Map :: NFData (f Int) => String -> ([Int] -> f Int) -> (f Int -> f Int) -> Map
+
+data Indexer where
+  Indexer :: NFData (f Int) => String -> ([Int] -> f Int) -> (f Int -> Int -> Int) -> Indexer
+
+data Updater where
+  Updater :: NFData (f Int) => String -> ([Int] -> f Int) -> (f Int -> Int -> f Int) -> Updater
+
+data Folder where
+  Folder :: (NFData (f Int), NFData a) => String -> ([Int] -> f Int) -> (f Int -> a) -> Folder
+
+sampleHashMap :: [Int] -> HashMap Int Int
+sampleHashMap is = HashMap.fromList $ fmap (\i -> (i, i)) is
+
+snocHashMap :: HashMap Int Int -> Int -> HashMap Int Int
+snocHashMap map i = HashMap.insert i i map
+
+main :: IO ()
+main =
+  defaultMainWith
+    defaultConfig
+    [ bgroup "snoc" $
+        snocs
+          [ Snocer "Data.Vector.Persistent" fromList Vector.Persistent.snoc,
+            Snocer "Data.Vector.Persistent.Other" Vector.Persistent.Other.fromList Vector.Persistent.Other.snoc,
+            Snocer "Data.RRBVector" fromList (RRBVector.|>),
+            Snocer "Data.Vector" fromList VB.snoc,
+            Snocer "Data.HashMap.Strict" sampleHashMap snocHashMap,
+            Snocer "Data.Sequence" fromList (Seq.|>)
+          ],
+      bgroup "fromList" $
+        fromLists
+          [ FromList "Data.Vector.Persistent" Vector.Persistent.fromList,
+            FromList "Data.RRBVector" RRBVector.fromList,
+            FromList "Data.Vector" VB.fromList,
+            FromList "Data.HashMap.Strict" sampleHashMap,
+            FromList "Data.Sequence" Seq.fromList
+          ],
+      bgroup "map" $
+        maps
+          [ Map "Data.Vector.Persistent" fromList (Vector.Persistent.map (20 +)),
+            Map "Data.Vector.Persistent.Other" Vector.Persistent.Other.fromList (Vector.Persistent.Other.map (20 +)),
+            Map "Data.RRBVector" fromList (RRBVector.map (20 +))
+          ],
+      bgroup "index" $
+        indexers
+          [ Indexer "Data.Vector.Persistent" fromList (\vec i -> fromJust $ Vector.Persistent.lookup i vec),
+            Indexer "Data.Vector.Persistent.Other" Vector.Persistent.Other.fromList (\vec i -> fromJust $ Vector.Persistent.Other.index vec i),
+            Indexer "Data.RRBVector" fromList (\vec i -> fromJust $ RRBVector.lookup i vec),
+            Indexer "Data.Vector" fromList (\vec i -> fromJust $ vec VB.!? i),
+            Indexer "Data.HashMap.Strict" sampleHashMap (\map i -> fromJust $ map HashMap.!? i),
+            Indexer "Data.Sequence" fromList (\seq i -> fromJust $ seq Seq.!? i)
+          ],
+      bgroup "update" $
+        updaters
+          [ Updater "Data.Vector.Persistent" fromList (\vec i -> Vector.Persistent.update i i vec),
+            Updater "Data.RRBVector" fromList (\vec i -> RRBVector.update i i vec),
+            -- be careful here, ptrEq might cause nothing to be inserted
+            Updater "Data.HashMap.Strict" sampleHashMap (\map i -> HashMap.insert i 0 map)
+          ],
+      bgroup "fold" $
+        vectorFolders
+          [ Folder "normal" Vector.Persistent.fromList sum,
+            -- Folder "toList" Vector.Persistent.fromList (sum . Vector.Persistent.toList),
+            -- Folder "streamL" Vector.Persistent.fromList Vector.Persistent.Internal.streamSumL,
+            -- Folder "streamR" Vector.Persistent.fromList Vector.Persistent.Internal.streamSumR,
+            Folder "Data.RRBVector" RRBVector.fromList sum
+          ],
+      bgroup "equality" $
+        vectorFolders
+          [ Folder "normal" Vector.Persistent.fromList (\x -> Vector.Persistent.Internal.persistentVectorEq x x)
+          ],
+      bgroup "compare" $
+        vectorFolders
+          [ Folder "normal" Vector.Persistent.fromList Vector.Persistent.Internal.persistentVectorCompare
+          ]
+    ]
+  where
+    bench' sections = bench $ List.intercalate "/" sections
+
+    -- 1.5x-2x faster than RRBVector
+    -- 2x faster than HashMap
+    -- way slower than Seq
+    snocs funcs =
+      [ env (pure $ sample []) $ \seq -> env (pure [1 .. size]) $ \list ->
+          ( bench'
+              [title, "size " ++ show size]
+              (whnf (foldl' func seq) list)
+          )
+        | size <- sizes,
+          Snocer title sample func <- funcs
+      ]
+
+    fromLists funcs =
+      [ env (pure [1 .. size]) $ \list ->
+          (bench' [title, "size " ++ show size] (whnf func list))
+        | size <- sizes,
+          FromList title func <- funcs
+      ]
+
+    maps funcs =
+      [ env (pure $ fromList [1 .. size]) $ \vec ->
+          (bench' [title, "size " ++ show size] (whnf func vec))
+        | size <- sizes,
+          Map title fromList func <- funcs
+      ]
+
+    -- 1.5x-2x faster than RRBVector
+    -- 2x slower than Vector
+    -- 2x faster than HashMap
+    -- Seq has really slow indexing
+    indexers funcs =
+      [ env
+          ( let seq = sample indices
+                indices = [0 .. size - 1]
+             in pure (seq, indices)
+          )
+          $ \(~(seq, indices)) ->
+            ( bench'
+                [title, "size " ++ show size]
+                ( whnf
+                    ( \indices ->
+                        foldl'
+                          (\seq index -> let !_ = func seq index in seq)
+                          seq
+                          indices
+                    )
+                    indices
+                )
+            )
+        | size <- sizes,
+          Indexer title sample func <- funcs
+      ]
+
+    updaters funcs =
+      [ env
+          ( let seq = sample indices
+                indices = [0 .. size - 1]
+             in pure (seq, indices)
+          )
+          $ \(~(seq, indices)) ->
+            ( bench'
+                [title, "size " ++ show size]
+                (whnf (\indices -> foldl' func seq indices) indices)
+            )
+        | size <- sizes,
+          Updater title sample func <- funcs
+      ]
+
+    vectorFolders funcs =
+      [ env (pure $ fromList [1 .. size]) $ \vec ->
+          ( bench'
+              [title, "size " ++ show size]
+              (nf func vec)
+          )
+        | size <- sizes,
+          Folder title fromList func <- funcs
+      ]
+
+sizes :: [Int]
+sizes = take 4 allSizes
+
+allSizes :: [Int]
+allSizes = [10 ^ i | i <- [1 :: Int ..]]
+
+-- streamSumL :: Vector.Persistent.Vector Int -> Int
+-- streamSumL = runIdentity . Stream.foldl' (+) 0 . streamL
+
+-- streamSumR :: Vector.Persistent.Vector Int -> Int
+-- streamSumR = runIdentity . Stream.foldl' (+) 0 . streamR
diff --git a/docs/diagram.png b/docs/diagram.png
new file mode 100644
Binary files /dev/null and b/docs/diagram.png differ
diff --git a/pvector.cabal b/pvector.cabal
new file mode 100644
--- /dev/null
+++ b/pvector.cabal
@@ -0,0 +1,139 @@
+cabal-version: 3.0
+name: pvector
+version: 0.1.0.0
+synopsis: Fast persistent vectors
+description:
+  An persistent vector is an efficient sequence data structure.
+  It supports fast indexing, iteration, snocing.
+homepage: https://github.com/oberblastmeister/pvector
+bug-reports: https://github.com/oberblastmeister/pvector/issues
+license: BSD-3-Clause
+license-file: LICENSE
+author: Brian Shu
+maintainer: littlebubu.shu@gmail.com
+copyright: 2022 Brian Shu
+category: Data
+extra-source-files:
+  CHANGELOG.md
+  README.md
+extra-doc-files:
+  docs/diagram.png
+tested-with: GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.2
+
+flag debug
+  description: Enable array bounds checking
+  manual: True
+  default: False
+
+common common-options
+  default-language: Haskell2010
+  default-extensions:
+    FlexibleInstances,
+    FlexibleContexts,
+    InstanceSigs,
+    MultiParamTypeClasses,
+    ConstraintKinds,
+    LambdaCase,
+    EmptyCase,
+    TupleSections,
+    BangPatterns,
+    TypeApplications,
+    StandaloneDeriving,
+    OverloadedStrings,
+    RankNTypes,
+    ScopedTypeVariables,
+    NamedFieldPuns,
+    DuplicateRecordFields,
+    DataKinds,
+    ConstraintKinds,
+    TypeApplications,
+    KindSignatures,
+    DeriveFoldable,
+    DeriveFunctor,
+    DeriveGeneric,
+    DeriveDataTypeable,
+    DeriveLift,
+    DeriveTraversable ,
+    GeneralizedNewtypeDeriving,
+    GADTs,
+    PolyKinds,
+    ViewPatterns,
+    PatternSynonyms,
+    TypeFamilies,
+    TypeFamilyDependencies,
+    FunctionalDependencies,
+    ExistentialQuantification,
+    TypeOperators,
+  ghc-options:
+    -Wall
+    -Wincomplete-record-updates
+    -Wredundant-constraints
+    -Wno-name-shadowing
+    -- until OverloadedRecordUpdate stabilizes
+    -Wno-ambiguous-fields
+    -Werror=incomplete-patterns
+    -Werror=incomplete-uni-patterns
+    -Werror=missing-methods
+  build-depends:
+    base >= 4.12 && <5,
+    primitive >= 0.6.4.0 && <0.8,
+    deepseq >=1.1 && <1.5,
+    vector-stream ^>= 0.1.0.0,
+
+library
+  import: common-options
+  hs-source-dirs: src
+  exposed-modules:
+    Data.Vector.Persistent
+    Data.Vector.Persistent.Unsafe
+    Data.Vector.Persistent.Internal
+    Data.Vector.Persistent.Internal.Buffer
+    Data.Vector.Persistent.Internal.Array
+    Data.Vector.Persistent.Internal.CoercibleUtils
+  if flag(debug)
+    cpp-options: -DDEBUG
+    if impl(ghc >= 9.2.2)
+      ghc-options: -fcheck-prim-bounds
+
+  -- uncomment to inspect generated code
+  -- ghc-options: -O2
+  -- ghc-options: -ddump-simpl -ddump-stg-final -ddump-cmm -ddump-asm -ddump-to-file
+  -- ghc-options: -dsuppress-coercions -dsuppress-unfoldings -dsuppress-module-prefixes
+  -- ghc-options: -dsuppress-uniques -dsuppress-timestamps
+
+common rtsopts
+  ghc-options:
+    -threaded
+    -rtsopts
+    -with-rtsopts=-N
+
+test-suite pvector-test
+  import: common-options, rtsopts
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Spec.hs
+  other-modules:
+    PersistentVectorSpec
+  build-depends:
+    pvector,
+    hspec ^>= 2.9.4,
+    QuickCheck ^>= 2.14.2,
+    quickcheck-instances ^>= 0.3.27,
+  build-tool-depends:
+    hspec-discover:hspec-discover,
+  cpp-options: -DTEST
+
+benchmark pvector-bench
+  import: common-options, rtsopts
+  type: exitcode-stdio-1.0
+  hs-source-dirs: bench
+  main-is: Main.hs
+  ghc-options: -O2
+  build-depends:
+    pvector,
+    criterion ^>= 1.5.13.0,
+    rrb-vector ^>= 0.1.1.0,
+    vector ^>= 0.12.3.1,
+    unordered-containers ^>= 0.2.17.0,
+    containers >= 0.5.5.1 && < 0.7,
+    persistent-vector ^>= 0.2.0,
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,61 @@
+-- |
+-- The @'Vector' a@ type is an persistent vector of elements of type @a@.
+--
+-- This module should be imported qualified, to avoid name clashes with the "Prelude".
+-- 
+-- Many operations have a average-case complexity of /O(log n)/.  The
+-- implementation uses a large base (i.e. 32) so in practice these
+-- operations are constant time.
+--
+-- = Comparison with Data.RRBVector and Data.Sequence
+-- * Persistent vectors generally have less operations than sequences or RRBVectors but those operations can be faster.
+-- * Persistent vectors have the fastest indexing.
+-- * Persistent vectors are faster than RRBVectors at snocing because of tail optimization.
+--   Snocing is a near constant time operation.
+--   Snocing is still slower than sequences.
+-- * RRBVectors are faster than persistent vectors at splitting and merging, but still slower than sequences.
+-- * RRBVectors are faster than Sequences at indexing but slower than persistent vectors.
+-- * Sequences have the fastest consing, snocing, and merging, but the slowest indexing.
+-- 
+-- ![diagram](docs/diagram.png)
+module Data.Vector.Persistent
+  ( foldr,
+    foldr',
+    foldl,
+    foldl',
+    Vector ((:|>), Empty),
+    (|>),
+    empty,
+    length,
+    lookup,
+    index,
+    (!?),
+    (!),
+    update,
+    adjust,
+    adjustF,
+    snoc,
+    singleton,
+    null,
+    (//),
+    (><),
+    map,
+    traverse,
+    toList,
+    fromList,
+    unsnoc,
+  )
+where
+
+import Data.Vector.Persistent.Internal
+import Prelude hiding
+  ( filter,
+    foldl,
+    foldr,
+    length,
+    lookup,
+    map,
+    null,
+    reverse,
+    traverse,
+  )
diff --git a/src/Data/Vector/Persistent/Internal.hs b/src/Data/Vector/Persistent/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Vector/Persistent/Internal.hs
@@ -0,0 +1,732 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Data.Vector.Persistent.Internal where
+
+import Control.Applicative (Alternative, liftA2)
+import qualified Control.Applicative
+import Control.DeepSeq (NFData (rnf), NFData1, rnf1)
+import qualified Control.DeepSeq
+import Control.Monad (MonadPlus)
+import qualified Control.Monad.Fail as Fail
+import Control.Monad.Primitive (PrimMonad)
+import Control.Monad.ST (runST)
+import Data.Bits (Bits, unsafeShiftL, unsafeShiftR, (.&.))
+import qualified Data.Foldable as Foldable
+import Data.Functor.Classes
+  ( Show1,
+    liftShowsPrec,
+    showsPrec1,
+    showsUnaryWith,
+  )
+import Data.Functor.Identity (Identity (..))
+import Data.Primitive.SmallArray
+import Data.Stream.Monadic (Stream (Stream))
+import qualified Data.Stream.Monadic as Stream
+import qualified Data.Traversable as Traversable
+import Data.Vector.Persistent.Internal.Array
+import qualified Data.Vector.Persistent.Internal.Buffer as Buffer
+import Data.Vector.Persistent.Internal.CoercibleUtils
+import GHC.Exts (IsList)
+import qualified GHC.Exts as Exts
+import GHC.Stack (HasCallStack)
+import Prelude hiding (init, length, lookup, map, null, tail)
+
+#ifdef INSPECTION
+{-# LANGUAGE TemplateHaskell #-}
+import Test.Inspection
+#endif
+
+type role Vector representational
+
+-- | A vector.
+--
+-- The instances are based on those of @Seq@s, which are in turn based on those of lists.
+data Vector a = -- |
+  -- Invariants: The only time tail can be empty is when init is empty.
+  -- Otherwise tailOffset will give the wrong value.
+  RootNode
+  { size :: !Int,
+    -- | 1 << 'shift' is the maximum that each child can contain
+    shift :: !Int,
+    init :: !(Array (Node a)),
+    tail :: !(Array a)
+  }
+
+instance Show1 Vector where
+  liftShowsPrec sp sl p v = showsUnaryWith (liftShowsPrec sp sl) "fromList" p (toList v)
+
+instance Show a => Show (Vector a) where
+  showsPrec = showsPrec1
+
+instance Eq a => Eq (Vector a) where
+  (==) = persistentVectorEq
+  {-# INLINE (==) #-}
+
+instance Ord a => Ord (Vector a) where
+  compare = persistentVectorCompare
+  {-# INLINE compare #-}
+
+instance Functor Vector where
+  fmap = Data.Vector.Persistent.Internal.map
+  {-# INLINE fmap #-}
+
+instance Foldable Vector where
+  foldr = Data.Vector.Persistent.Internal.foldr
+  {-# INLINE foldr #-}
+  foldl = Data.Vector.Persistent.Internal.foldl
+  {-# INLINE foldl #-}
+  foldl' = Data.Vector.Persistent.Internal.foldl'
+  {-# INLINE foldl' #-}
+  foldr' = Data.Vector.Persistent.Internal.foldr'
+  {-# INLINE foldr' #-}
+  length = Data.Vector.Persistent.Internal.length
+  {-# INLINE length #-}
+  null = Data.Vector.Persistent.Internal.null
+  {-# INLINE null #-}
+
+instance Traversable Vector where
+  traverse = Data.Vector.Persistent.Internal.traverse
+  {-# INLINE traverse #-}
+
+instance Semigroup (Vector a) where
+  (<>) = (><)
+  {-# INLINE (<>) #-}
+
+instance Monoid (Vector a) where
+  mempty = empty
+  {-# INLINE mempty #-}
+
+instance NFData a => NFData (Vector a) where
+  rnf = rnf1
+  {-# INLINE rnf #-}
+
+instance Applicative Vector where
+  pure = singleton
+  {-# INLINE pure #-}
+  fs <*> xs = foldl' (\acc f -> acc >< map f xs) empty fs
+
+instance Monad Vector where
+  xs >>= f = foldl' (\acc x -> acc >< f x) empty xs
+  {-# INLINE (>>=) #-}
+
+instance Fail.MonadFail Vector where
+  fail _ = empty
+  {-# INLINE fail #-}
+
+instance Alternative Vector where
+  empty = empty
+  {-# INLINE empty #-}
+  (<|>) = (><)
+  {-# INLINE (<|>) #-}
+
+instance MonadPlus Vector
+
+instance NFData1 Vector where
+  liftRnf f = foldl' (\_ x -> f x) ()
+  {-# INLINE liftRnf #-}
+
+data Node a
+  = InternalNode {getInternalNode :: !(Array (Node a))}
+  | DataNode {getDataNode :: !(Array a)}
+  deriving (Show)
+
+instance Eq a => Eq (Node a) where
+  (==) = nodeEq
+  {-# INLINE (==) #-}
+
+instance Ord a => Ord (Node a) where
+  compare = nodeCompare
+  {-# INLINE compare #-}
+
+instance IsList (Vector a) where
+  type Item (Vector a) = a
+  fromList = Data.Vector.Persistent.Internal.fromList
+  {-# INLINE fromList #-}
+  toList = Data.Vector.Persistent.Internal.toList
+  {-# INLINE toList #-}
+
+-- | \(O(n)\) Lazy right fold.
+foldr :: (a -> b -> b) -> b -> Vector a -> b
+foldr f z = runIdentity #. Stream.foldr f z . streamL
+{-# INLINE foldr #-}
+
+-- | \(O(n)\) Strict right fold.
+foldr' :: (a -> b -> b) -> b -> Vector a -> b
+foldr' f z = runIdentity #. Stream.foldl' (flip f) z . streamR
+{-# INLINE foldr' #-}
+
+-- | \(O(n)\) Lazy left fold.
+foldl :: (b -> a -> b) -> b -> Vector a -> b
+foldl f z = runIdentity #. Stream.foldr (flip f) z . streamR
+{-# INLINE foldl #-}
+
+-- | \(O(n)\) Strict left fold.
+foldl' :: (b -> a -> b) -> b -> Vector a -> b
+foldl' f z = runIdentity #. Stream.foldl' f z . streamL
+{-# INLINE foldl' #-}
+
+-- | \(O(n)\) Indexed lazy right fold.
+ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b
+ifoldr f z = runIdentity #. Stream.foldr (uncurry f) z . istreamL
+{-# INLINE ifoldr #-}
+
+-- | \(O(n)\) Indexed lazy left fold.
+ifoldl :: (Int -> b -> a -> b) -> b -> Vector a -> b
+ifoldl f z = runIdentity #. Stream.foldr (\(i, x) y -> f i y x) z . istreamR
+{-# INLINE ifoldl #-}
+
+-- | \(O(n)\) Indexed strict right fold.
+ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b
+ifoldr' f z = runIdentity #. Stream.foldl' (\y (i, x) -> f i x y) z . istreamR
+{-# INLINE ifoldr' #-}
+
+-- | \(O(n)\) Indexed strict left fold.
+ifoldl' :: (Int -> b -> a -> b) -> b -> Vector a -> b
+ifoldl' f z = runIdentity #. Stream.foldl' (\y (i, x) -> f i y x) z . istreamL
+{-# INLINE ifoldl' #-}
+
+persistentVectorEq :: Eq a => Vector a -> Vector a -> Bool
+persistentVectorEq
+  RootNode {size, shift, init, tail}
+  RootNode {size = size', shift = shift', init = init', tail = tail'} =
+    size == size' && (size == 0 || (shift == shift' && tail == tail' && init == init'))
+{-# INLINEABLE persistentVectorEq #-}
+
+nodeEq :: Eq a => Node a -> Node a -> Bool
+nodeEq (InternalNode ns) (InternalNode ns') = ns == ns'
+nodeEq (DataNode as) (DataNode as') = as == as'
+nodeEq _ _ = False
+{-# INLINEABLE nodeEq #-}
+
+persistentVectorCompare :: Ord a => Vector a -> Vector a -> Ordering
+persistentVectorCompare
+  RootNode {size, init, tail}
+  RootNode {size = size', init = init', tail = tail'} =
+    compare size size'
+      <> if size == 0
+        then EQ
+        else compare init init' <> compare tail tail'
+{-# INLINEABLE persistentVectorCompare #-}
+
+nodeCompare :: Ord a => Node a -> Node a -> Ordering
+nodeCompare (DataNode as) (DataNode as') = compare as as'
+nodeCompare (InternalNode ns) (InternalNode ns') = compare ns ns'
+nodeCompare (DataNode _) (InternalNode _) = LT
+nodeCompare (InternalNode _) (DataNode _) = GT
+{-# INLINEABLE nodeCompare #-}
+
+-- | \(O(1)\). A vector with a single element.
+singleton :: a -> Vector a
+singleton a = RootNode {size = 1, shift = keyBits, tail = singletonSmallArray a, init = emptySmallArray}
+{-# INLINE singleton #-}
+
+-- | \(O(1)\). The empty vector.
+empty :: Vector a
+empty = RootNode {size = 0, shift = keyBits, init = emptySmallArray, tail = emptySmallArray}
+{-# NOINLINE empty #-}
+
+-- | \(O(1)\) Return 'True' if the vector is empty, 'False' otherwise.
+null :: Vector a -> Bool
+null xs = length xs == 0
+{-# INLINE null #-}
+
+-- | \(O(\log n)\). An alias for 'snoc'
+-- Mnemonic: a triangle with the single element at the pointy end.
+(|>) :: Vector a -> a -> Vector a
+(|>) = snoc
+{-# INLINE (|>) #-}
+
+-- | \(O(\log n)\). A bidirectional pattern synonym viewing the rear of a non-empty
+-- sequence.
+pattern (:|>) :: Vector a -> a -> Vector a
+pattern vec :|> x <-
+  (unsnoc -> Just (vec, x))
+  where
+    vec :|> x = vec |> x
+
+infixl 5 :|>
+
+-- | \(O(1)\). A bidirectional pattern synonym matching an empty sequence.
+pattern Empty :: Vector a
+pattern Empty <-
+  (null -> True)
+  where
+    Empty = empty
+
+{-# COMPLETE (:|>), Empty #-}
+
+-- | \(O(\log n)\) Add an element to the end of the vector.
+snoc :: Vector a -> a -> Vector a
+snoc vec@RootNode {size, tail} a
+  -- Room in tail, and vector non-empty
+  | (size .&. keyMask) /= 0 =
+      vec
+        { tail = updateResizeSmallArray tail (size .&. keyMask) a,
+          size = size + 1
+        }
+  | otherwise = snocArr vec 1 $ singletonSmallArray a
+{-# INLINEABLE snoc #-}
+
+-- Invariant: the tail must be large enough to mutably write to it
+-- Best to use this with emptyMaxTail
+-- After calling this many times you must run shrink
+unsafeSnoc :: Vector a -> a -> Vector a
+unsafeSnoc vec@RootNode {size, tail} a
+  -- Room in tail, and vector non-empty
+  | (size .&. keyMask) /= 0 =
+      vec
+        { tail =
+            -- update the array in place
+            runST $ do
+              marr <- unsafeThawSmallArray tail
+              writeSmallArray marr (size .&. keyMask) a
+              unsafeFreezeSmallArray marr,
+          size = size + 1
+        }
+  | otherwise = snocArr vec 1 $ singletonSmallArray a
+{-# INLINEABLE unsafeSnoc #-}
+
+-- Invariant: arr cannot be empty
+snocArr ::
+  -- | The Vector to perform the operation on
+  Vector a ->
+  -- | The the added size. We can't find this from the array because the array might have bogus size due to undefined elements
+  Int ->
+  -- | The array to add as the new tail
+  Array a ->
+  Vector a
+snocArr vec@RootNode {size, shift, tail} addedSize arr
+  | null vec =
+      RootNode
+        { size = addedSize,
+          shift = keyBits,
+          tail = arr,
+          init = emptySmallArray
+        }
+  | size !>>. keyBits > 1 !<<. shift =
+      RootNode
+        { size = size + addedSize,
+          shift = shift + keyBits,
+          init =
+            let !path = newPath shift tail
+                !internal = InternalNode $ init vec
+             in twoSmallArray internal path,
+          tail = arr
+        }
+  | otherwise =
+      RootNode
+        { size = size + addedSize,
+          shift,
+          init = snocTail size tail shift $ init vec,
+          tail = arr
+        }
+{-# INLINE snocArr #-}
+
+snocTail :: Int -> Array a -> Int -> Array (Node a) -> Array (Node a)
+snocTail size tail = go
+  where
+    go !level !parent = updateResizeSmallArray parent subIx toInsert
+      where
+        toInsert
+          | level == keyBits = DataNode tail
+          | subIx < sizeofSmallArray parent =
+              let vec' = indexSmallArray parent subIx
+               in InternalNode $ go (level - keyBits) (getInternalNode vec')
+          | otherwise = newPath (level - keyBits) tail
+        subIx = ((size - 1) !>>. level) .&. keyMask
+{-# INLINE snocTail #-}
+
+newPath :: Int -> Array a -> Node a
+newPath 0 tail = DataNode tail
+newPath level tail = InternalNode $ singletonSmallArray $! newPath (level - keyBits) tail
+
+unsafeIndex :: Vector a -> Int -> a
+unsafeIndex vec ix | (# a #) <- Exts.inline unsafeIndex# vec ix = a
+{-# NOINLINE unsafeIndex #-}
+
+unsafeIndex# :: Vector a -> Int -> (# a #)
+unsafeIndex# vec ix
+  | ix >= tailOffset vec = indexSmallArray## (tail vec) (ix .&. keyMask)
+  -- no need to use keyMask here as we are at the top
+  | otherwise = go ix (shift vec - keyBits) (indexSmallArray (init vec) (ix !>>. shift vec))
+  where
+    go ix 0 !node = indexSmallArray## (getDataNode node) (ix .&. keyMask)
+    go ix level !node = go ix (level - keyBits) (indexSmallArray (getInternalNode node) ix')
+      where
+        ix' = (ix !>>. level) .&. keyMask
+{-# NOINLINE unsafeIndex# #-}
+
+lookup# :: Int -> Vector a -> (# (# #)| a #)
+lookup# ix vec
+  | (fromIntegral ix :: Word) >= fromIntegral (length vec) = (# (##) | #)
+  | otherwise = case Exts.inline unsafeIndex# vec ix of (# x #) -> (# | x #)
+{-# NOINLINE lookup# #-}
+
+-- | \(O(\log n)\). The element at the index or 'Nothing' if the index is out of range.
+lookup :: Int -> Vector a -> Maybe a
+lookup ix vec
+  | (fromIntegral ix :: Word) >= fromIntegral (length vec) = Nothing
+  | otherwise = case unsafeIndex# vec ix of (# x #) -> Just x
+{-# INLINE lookup #-}
+
+-- | \(O(\log n)\). The element at the index. Calls 'error' if the index is out of range.
+index :: HasCallStack => Int -> Vector a -> a
+index ix vec
+  | ix < 0 = moduleError "index" $ "negative index: " ++ show ix
+  | ix >= length vec = moduleError "index" $ "index too large: " ++ show ix
+  | otherwise = Exts.inline unsafeIndex vec ix
+{-# INLINEABLE index #-}
+
+-- | \(O(\log n)\). A flipped version of 'index'.
+(!) :: HasCallStack => Vector a -> Int -> a
+(!) = flip index
+{-# INLINE (!) #-}
+
+-- | \(O(\log n)\). A flipped version of 'lookup'.
+(!?) :: Vector a -> Int -> Maybe a
+(!?) = flip lookup
+{-# INLINE (!?) #-}
+
+-- | \(O(\log n)\). Adjust the element at the index by applying the function to it.
+-- If the index is out of range, the original vector is returned.
+adjust :: (a -> a) -> Int -> Vector a -> Vector a
+adjust f = adjust# $ \x -> (# f x #)
+{-# INLINE adjust #-}
+
+adjust# :: (a -> (# a #)) -> Int -> Vector a -> Vector a
+adjust# f ix vec@RootNode {size, shift, tail}
+  -- 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 size = vec
+  | ix >= tailOffset vec = vec {tail = modifySmallArray# tail (ix .&. keyMask) f}
+  | otherwise = vec {init = go ix shift (init vec)}
+  where
+    go ix level vec
+      | level == keyBits,
+        let !node = DataNode $ modifySmallArray# (getDataNode vec') (ix .&. keyMask) f =
+          updateSmallArray vec ix' node
+      | otherwise,
+        let !node = go ix (level - keyBits) (getInternalNode vec') =
+          updateSmallArray vec ix' $! InternalNode node
+      where
+        ix' = (ix !>>. level) .&. keyBits
+        vec' = indexSmallArray vec ix'
+{-# INLINE adjust# #-}
+
+-- | \(O(\log n)\). Same as 'adjust' but can have effects through 'Applicative'
+adjustF :: Applicative f => (a -> f a) -> Int -> Vector a -> f (Vector a)
+adjustF f ix vec@RootNode {size, shift, tail}
+  -- 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 size = pure vec
+  | ix >= tailOffset vec = (\tail -> vec {tail}) <$> modifySmallArrayF tail (ix .&. keyMask) f
+  | otherwise = (\init -> vec {init}) <$> go ix shift (init vec)
+  where
+    go ix level vec
+      | level == keyBits =
+          (\node' -> updateSmallArray vec ix' $! DataNode node')
+            <$> modifySmallArrayF (getDataNode vec') (ix .&. keyMask) f
+      | otherwise =
+          (\node -> updateSmallArray vec ix' $! InternalNode node)
+            <$> go ix (level - keyBits) (getInternalNode vec')
+      where
+        ix' = (ix !>>. level) .&. keyBits
+        vec' = indexSmallArray vec ix'
+{-# INLINE adjustF #-}
+
+-- | \(O(\log n)\). Replace the element at the specified position.
+-- If the position is out of range, the original sequence is returned.
+update :: Int -> a -> Vector a -> Vector a
+-- we could use adjust# (\_ -> (# x #)) to implement this
+-- and the const like function would get optimized out
+-- but we don't because we don't want to create any closures for the go function
+-- so we rewrite out the loop and also lambda lift some arguments
+-- also: trees are very shallow, so the loop won't be called much.
+-- So allocating a closure to not have pass the arguments on the stack has too much overhead
+update ix x vec@RootNode {size, shift, tail}
+  -- 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 size = vec
+  | ix >= tailOffset vec = vec {tail = updateSmallArray tail (ix .&. keyMask) x}
+  | otherwise = vec {init = go ix x shift (init vec)}
+  where
+    go ix x level vec
+      | level == keyBits =
+          let !node = DataNode $ updateSmallArray (getDataNode vec') (ix .&. keyMask) x
+           in updateSmallArray vec ix' node
+      | otherwise =
+          let !node = go ix x (level - keyBits) (getInternalNode vec')
+           in updateSmallArray vec ix' $! InternalNode node
+      where
+        ix' = (ix !>>. level) .&. keyMask
+        vec' = indexSmallArray vec ix'
+{-# INLINEABLE update #-}
+
+-- | \(O(\log n)\). Decompose a list into its head and tail.
+--
+-- * If the list is empty, returns 'Nothing'.
+-- * If the list is non-empty, returns @'Just' (x, xs)@,
+-- where @x@ is the head of the list and @xs@ its tail.
+unsnoc :: Vector a -> Maybe (Vector a, a)
+unsnoc vec@RootNode {size, tail, init, shift}
+  | 0 <- size = Nothing
+  -- we need to have this case because we can't run unsnocTail, there is nothing left in the tail
+  | 1 <- size, (# x #) <- indexSmallArray## tail 0 = Just (empty, x)
+  | nullSmallArray tail',
+    (# init', tail' #) <- unsnocTail# size shift init =
+      Just (vec {size = size - 1, init = init', tail = tail'}, a)
+  | otherwise = Just (vec {size = size - 1, tail = tail'}, a)
+  where
+    a = lastSmallArray tail
+    tail' = popSmallArray tail
+{-# INLINEABLE unsnoc #-}
+
+unsnocTail# :: Int -> Int -> Array (Node a) -> (# Array (Node a), Array a #)
+unsnocTail# = go
+  where
+    go size !level !parent
+      | level == keyBits = (# popSmallArray parent, getDataNode child #)
+      | otherwise = do
+          let (# child', tail #) = go size (level - keyBits) (getInternalNode child)
+          if nullSmallArray child'
+            then (# popSmallArray parent, tail #)
+            else (# updateSmallArray parent subIx $ InternalNode child', tail #)
+      where
+        child = indexSmallArray parent subIx
+        -- we need to subtract 2 because the first subtraction gets us to the tail element
+        -- the second subtraction gets to the last element in the tree
+        subIx = ((size - 2) !>>. level) .&. keyMask
+{-# INLINE unsnocTail# #-}
+
+-- | 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.
+--
+-- Caution: Only gives a sensible result if the vector is nonempty.
+tailOffset :: Vector a -> Int
+tailOffset vec = (length vec - 1) .&. ((-1) !<<. keyBits)
+{-# INLINE tailOffset #-}
+
+-- | \(O(1)\) Get the length of the vector.
+length :: Vector a -> Int
+length = size
+{-# INLINE length #-}
+
+impossibleError :: forall a. a
+impossibleError = error "this should be impossible"
+
+moduleError :: forall a. HasCallStack => String -> String -> a
+moduleError fun msg = error ("Data.Vector.Persistent.Internal" ++ fun ++ ':' : ' ' : msg)
+{-# NOINLINE moduleError #-}
+
+toList :: Vector a -> [a]
+toList = pureStreamToList . streamL
+{-# INLINE toList #-}
+
+-- | Convert a 'Stream' to a list
+pureStreamToList :: Stream Identity a -> [a]
+pureStreamToList s = Exts.build (\c n -> runIdentity $ Stream.foldr c n s)
+{-# INLINE pureStreamToList #-}
+
+-- | \(O(n)\). Apply a function to all values in the vector.
+map :: (a -> b) -> Vector a -> Vector b
+map f vec@RootNode {init, tail} = vec {tail = fmap f tail, init = mapSmallArray' go init}
+  where
+    go (DataNode as) = DataNode $ fmap f as
+    go (InternalNode ns) = InternalNode $ mapSmallArray' go ns
+{-# INLINE map #-}
+
+-- | \(O(n)\). Apply a function to all values of a vector and its index.
+imap :: (Int -> a -> b) -> Vector a -> Vector b
+imap f vec@RootNode {size, shift, init, tail}
+  | size == 0 = empty
+  | otherwise =
+      vec
+        { init = imapStepSmallArray 0 (1 !<<. shift) (go $! shift - keyBits) init,
+          tail = imapStepSmallArray (tailOffset vec) 1 f tail
+        }
+  where
+    go _shift i0 (DataNode as) = DataNode $ imapStepSmallArray i0 1 f as
+    go shift i0 (InternalNode ns) = InternalNode $ imapStepSmallArray i0 (1 !<<. shift) (go $! shift - keyBits) ns
+{-# INLINE imap #-}
+
+traverse :: Applicative f => (a -> f b) -> Vector a -> f (Vector b)
+traverse f vec@RootNode {init, tail} =
+  liftA2
+    (\init tail -> vec {init, tail})
+    (Traversable.traverse go init)
+    (Traversable.traverse f tail)
+  where
+    go (DataNode as) = DataNode <$> Traversable.traverse f as
+    go (InternalNode ns) = InternalNode <$> Traversable.traverse go ns
+{-# INLINE traverse #-}
+
+itraverse :: Applicative f => (Int -> a -> f b) -> Vector a -> f (Vector b)
+itraverse f vec@RootNode {size, shift, init, tail}
+  | size == 0 = pure empty
+  | otherwise =
+      liftA2
+        (\init tail -> vec {init, tail})
+        (itraverseStepSmallArray 0 (1 !<<. shift) (go $! shift - keyBits) init)
+        (itraverseStepSmallArray (tailOffset vec) 1 f tail)
+  where
+    go _shift i0 (DataNode as) = DataNode <$> itraverseStepSmallArray i0 1 f as
+    go shift i0 (InternalNode ns) = InternalNode <$> itraverseStepSmallArray i0 (1 !<<. shift) (go $! shift - keyBits) ns
+{-# INLINE itraverse #-}
+
+-- | \(O(n)\). For each pair @(i,a)@ from the vector of index/value pairs,
+-- replace the vector element at position @i@ by @a@.
+--
+-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7>
+(//) :: Vector a -> [(Int, a)] -> Vector a
+(//) = Exts.inline Foldable.foldl' $ flip $ uncurry update
+
+-- | \(O(n)\). Concatenate two vectors.
+(><) :: Vector a -> Vector a -> Vector a
+(><) = Exts.inline foldl' snoc
+
+-- | Check the invariant of the vector
+invariant :: Vector a -> Bool
+invariant _vec = True
+
+-- | \(O(n)\). Create a vector from a list.
+fromList :: [a] -> Vector a
+fromList = unstream . Stream.fromList
+
+keyBits :: Int
+#ifdef TEST
+keyBits = 1
+#else
+keyBits = 5
+#endif
+
+nodeWidth :: Int
+nodeWidth = 1 !<<. keyBits
+
+keyMask :: Int
+keyMask = nodeWidth - 1
+
+(!<<.) :: Bits a => a -> Int -> a
+(!<<.) = unsafeShiftL
+{-# INLINE (!<<.) #-}
+
+(!>>.) :: Bits a => a -> Int -> a
+(!>>.) = unsafeShiftR
+{-# INLINE (!>>.) #-}
+
+infixl 8 !<<., !>>.
+
+unstream :: Stream Identity a -> Vector a
+unstream stream = runST $ do
+  streamToContents stream >>= \case
+    (size, tail, [tree]) ->
+      pure RootNode {size, shift = keyBits, tail, init = pure tree}
+    (size, tail, ls') -> do
+      let iterateNodes !shift trees =
+            nodes (Prelude.reverse trees) >>= \case
+              [tree] -> pure RootNode {size, shift, tail, init = getInternalNode tree}
+              trees' -> iterateNodes (shift + keyBits) trees'
+      iterateNodes keyBits ls'
+  where
+    nodes trees = do
+      buffer <- Buffer.newWithCapacity nodeWidth
+      (buffer, acc) <-
+        Foldable.foldlM
+          ( \(!buffer, acc) t ->
+              if Buffer.length buffer == nodeWidth
+                then do
+                  result <- Buffer.freeze buffer
+                  buffer <- Buffer.push t $ Buffer.clear buffer
+                  pure (buffer, InternalNode result : acc)
+                else do
+                  buffer <- Buffer.push t buffer
+                  pure (buffer, acc)
+          )
+          (buffer, [])
+          trees
+      final <- Buffer.unsafeFreeze buffer
+      pure $ InternalNode final : acc
+{-# INLINE unstream #-}
+
+streamToContents :: PrimMonad m => Stream Identity a -> m (Int, SmallArray a, [Node a])
+streamToContents (Stream step s) = do
+  buffer <- Buffer.newWithCapacity nodeWidth
+  loop (0 :: Int) buffer [] s
+  where
+    loop !size !buffer acc s = do
+      case runIdentity $ step s of
+        Stream.Yield x s' -> do
+          if Buffer.length buffer == nodeWidth
+            then do
+              result <- Buffer.freeze buffer
+              buffer <- Buffer.push x $ Buffer.clear buffer
+              loop (size + 1) buffer (DataNode result : acc) s'
+            else do
+              buffer <- Buffer.push x buffer
+              loop (size + 1) buffer acc s'
+        Stream.Skip s' -> loop size buffer acc s'
+        Stream.Done -> do
+          tail <- Buffer.unsafeFreeze buffer
+          pure (size, tail, acc)
+{-# INLINE streamToContents #-}
+
+streamL :: Monad m => Vector a -> Stream m a
+streamL RootNode {init, tail} = Stream step [(InternalNode init, 0 :: Int), (DataNode tail, 0)]
+  where
+    step [] = pure Stream.Done
+    step ((n, i) : rest) = case n of
+      InternalNode ns
+        | i >= sizeofSmallArray ns -> pure $ Stream.Skip rest
+        | otherwise -> do
+            let !(# ns' #) = indexSmallArray## ns i
+                !i' = i + 1
+            pure $ Stream.Skip $ (ns', 0) : (n, i') : rest
+      DataNode xs
+        | i >= sizeofSmallArray xs -> pure $ Stream.Skip rest
+        | otherwise -> do
+            let !(# x #) = indexSmallArray## xs i
+                !i' = i + 1
+            pure $ Stream.Yield x $ (n, i') : rest
+    {-# INLINE step #-}
+{-# INLINE streamL #-}
+
+streamR :: Monad m => Vector a -> Stream m a
+streamR RootNode {init, tail} = Stream step [(DataNode tail, tailSize), (InternalNode init, initSize)]
+  where
+    !tailSize = sizeofSmallArray tail - 1
+    !initSize = sizeofSmallArray init - 1
+
+    step [] = pure Stream.Done
+    step ((n, i) : rest) = case n of
+      InternalNode ns
+        | i < 0 -> pure $ Stream.Skip rest
+        | otherwise -> do
+            let !(# n' #) = indexSmallArray## ns i
+                !i' = i - 1
+            pure $ case n' of
+              InternalNode ns -> do
+                let !z = sizeofSmallArray ns - 1
+                Stream.Skip $ (n', z) : (n, i') : rest
+              DataNode xs -> do
+                let !z = sizeofSmallArray xs - 1
+                Stream.Skip $ (n', z) : (n, i') : rest
+      DataNode xs
+        | i < 0 -> pure $ Stream.Skip rest
+        | otherwise -> do
+            let !(# x #) = indexSmallArray## xs i
+                !i' = i - 1
+            pure $ Stream.Yield x $ (n, i') : rest
+    {-# INLINE step #-}
+{-# INLINE streamR #-}
+
+istreamL :: Monad m => Vector a -> Stream m (Int, a)
+istreamL = Stream.indexed . streamL
+{-# INLINE istreamL #-}
+
+istreamR :: Monad m => Vector a -> Stream m (Int, a)
+istreamR vec = Stream.indexedR (length vec - 1) $ streamR vec
+{-# INLINE istreamR #-}
diff --git a/src/Data/Vector/Persistent/Internal/Array.hs b/src/Data/Vector/Persistent/Internal/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Vector/Persistent/Internal/Array.hs
@@ -0,0 +1,241 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Data.Vector.Persistent.Internal.Array
+  ( Array,
+    MArray,
+    nullSmallArray,
+    lastSmallArray,
+    singletonSmallArray,
+    twoSmallArray,
+    updateSmallArray,
+    modifySmallArray,
+    modifySmallArrayF,
+    modifySmallArray',
+    updateResizeSmallArray,
+    popSmallArray,
+    undefinedElem,
+    ifoldrStepSmallArray,
+    ifoldlStepSmallArray,
+    ifoldrStepSmallArray',
+    ifoldlStepSmallArray',
+    imapStepSmallArray,
+    imapStepSmallArray',
+    itraverseStepSmallArray,
+    modifySmallArray#,
+    mapSmallArray#,
+    shrinkSmallMutableArray_,
+  )
+where
+
+import Control.Applicative (liftA2)
+import Control.Monad (when)
+import Control.Monad.Primitive (PrimMonad, PrimState)
+import Control.Monad.ST (ST, runST)
+import Data.Coerce (coerce)
+import Data.Functor (($>))
+import Data.Functor.Identity (Identity (..))
+import qualified Data.Primitive as Primitive
+import Data.Primitive.SmallArray
+import GHC.Exts (SmallMutableArray#)
+
+type Array = SmallArray
+
+type MArray = SmallMutableArray
+
+-- | Used to support older ghcs.
+shrinkSmallMutableArray_ :: PrimMonad m => MArray (PrimState m) a -> Int -> m (MArray (PrimState m) a)
+#if __GLASGOW_HASKELL__ >= 810
+shrinkSmallMutableArray_ marr n = Primitive.shrinkSmallMutableArray marr n $> marr
+#else
+shrinkSmallMutableArray_ mary n = Primitive.cloneSmallMutableArray mary 0 n
+#endif 
+{-# INLINE shrinkSmallMutableArray_ #-}
+
+mapSmallArray# :: (a -> (# b #)) -> SmallArray a -> SmallArray b
+mapSmallArray# f sa = createSmallArray (length sa) (error "mapSmallArray#") $ \smb -> do
+  let go i =
+        when (i < length sa) $ do
+          x <- indexSmallArrayM sa i
+          let !(# y #) = f x
+          writeSmallArray smb i y *> go (i + 1)
+  go 0
+{-# INLINE mapSmallArray# #-}
+
+nullSmallArray :: SmallArray a -> Bool
+nullSmallArray arr = sizeofSmallArray arr == 0
+{-# INLINE nullSmallArray #-}
+
+lastSmallArray :: SmallArray a -> a
+lastSmallArray arr = indexSmallArray arr $ sizeofSmallArray arr
+
+singletonSmallArray :: a -> Array a
+singletonSmallArray a = runSmallArray $ newSmallArray 1 a
+{-# INLINE singletonSmallArray #-}
+
+twoSmallArray :: a -> a -> Array a
+twoSmallArray x y = runSmallArray $ do
+  marr <- newSmallArray 2 x
+  writeSmallArray marr 1 y
+  pure marr
+{-# INLINE twoSmallArray #-}
+
+updateSmallArray :: Array a -> Int -> a -> Array a
+updateSmallArray arr i x = modifySmallArray# arr i $ \_ -> (# x #)
+{-# INLINE updateSmallArray #-}
+
+modifySmallArray :: Array a -> Int -> (a -> a) -> Array a
+modifySmallArray arr i f = modifySmallArray# arr i $ \x -> (# f x #)
+{-# INLINE modifySmallArray #-}
+
+modifySmallArrayF :: Functor f => Array a -> Int -> (a -> f a) -> f (Array a)
+modifySmallArrayF arr i f | (# x #) <- indexSmallArray## arr i = updateSmallArray arr i <$> f x
+{-# INLINE modifySmallArrayF #-}
+
+modifySmallArray' :: Array a -> Int -> (a -> a) -> Array a
+modifySmallArray' arr i f = modifySmallArray# arr i $ \x -> let !x' = f x in (# x' #)
+{-# INLINE modifySmallArray' #-}
+
+modifySmallArray# :: Array a -> Int -> (a -> (# a #)) -> Array a
+modifySmallArray# arr i f = runSmallArray $ do
+  marr <- thawSmallArray arr 0 $ sizeofSmallArray arr
+  x <- indexSmallArrayM arr i
+  let !(# x' #) = f x
+  writeSmallArray marr i x'
+  pure marr
+{-# INLINE modifySmallArray# #-}
+
+updateResizeSmallArray :: Array a -> Int -> a -> Array a
+updateResizeSmallArray arr i a = runSmallArray $ do
+  marr <- thawSmallArray arr 0 (max len (i + 1))
+  writeSmallArray marr i a
+  pure marr
+  where
+    len = sizeofSmallArray arr
+{-# INLINE updateResizeSmallArray #-}
+
+popSmallArray :: Array a -> Array a
+popSmallArray arr = runSmallArray $ thawSmallArray arr 0 (sizeofSmallArray arr - 1)
+{-# INLINE popSmallArray #-}
+
+undefinedElem :: forall a. a
+undefinedElem = error "undefined element"
+{-# NOINLINE undefinedElem #-}
+
+ifoldrStepSmallArray :: Int -> Int -> (Int -> a -> b -> b) -> b -> SmallArray a -> b
+ifoldrStepSmallArray i0 step f z arr = do
+  let len = sizeofSmallArray arr
+      go i j
+        | i == len = z
+        | (# x #) <- indexSmallArray## arr i = f j x (go (i + 1) $! j + step)
+  go 0 i0
+{-# INLINE ifoldrStepSmallArray #-}
+
+ifoldlStepSmallArray :: Int -> Int -> (Int -> b -> a -> b) -> b -> SmallArray a -> b
+ifoldlStepSmallArray i0 step f z arr = do
+  let len = sizeofSmallArray arr
+      go i j
+        | i < 0 = z
+        | (# x #) <- indexSmallArray## arr i = f j (go (i - 1) $! j - step) x
+  go (len - 1) i0
+{-# INLINE ifoldlStepSmallArray #-}
+
+ifoldrStepSmallArray' :: Int -> Int -> (Int -> a -> b -> b) -> b -> SmallArray a -> b
+ifoldrStepSmallArray' i0 step f z arr = do
+  let go i j acc
+        | i < 0 = acc
+        | (# x #) <- indexSmallArray## arr i = (go (i - 1) $! (j - step)) $! f j x acc
+  go (sizeofSmallArray arr) i0 z
+{-# INLINE ifoldrStepSmallArray' #-}
+
+ifoldlStepSmallArray' :: Int -> Int -> (Int -> b -> a -> b) -> b -> SmallArray a -> b
+ifoldlStepSmallArray' i0 step f z arr = do
+  let go i j acc
+        | i == sizeofSmallArray arr = acc
+        | (# x #) <- indexSmallArray## arr i = (go (i + 1) $! (j + step)) $! f j acc x
+  go 0 i0 z
+{-# INLINE ifoldlStepSmallArray' #-}
+
+imapStepSmallArray :: Int -> Int -> (Int -> a -> b) -> SmallArray a -> SmallArray b
+imapStepSmallArray i0 step f arr = createSmallArray len undefinedElem $ \marr -> do
+  let go i k = when (i < len) $ do
+        x <- indexSmallArrayM arr i
+        writeSmallArray marr i (f k x)
+        go (i + 1) $! k + step
+  go 0 i0
+  where
+    len = sizeofSmallArray arr
+{-# INLINE imapStepSmallArray #-}
+
+imapStepSmallArray' :: Int -> (a -> Int) -> (Int -> a -> b) -> SmallArray a -> SmallArray b
+imapStepSmallArray' i0 step f arr = createSmallArray len undefinedElem $ \marr -> do
+  let go i k = when (i < len) $ do
+        x <- indexSmallArrayM arr i
+        writeSmallArray marr i $! f k x
+        go (i + 1) $! k + step x
+  go 0 i0
+  where
+    len = sizeofSmallArray arr
+{-# INLINE imapStepSmallArray' #-}
+
+newtype STA a = STA {_runSTA :: forall s. SmallMutableArray# s a -> ST s (SmallArray a)}
+
+runSTA :: Int -> STA a -> SmallArray a
+runSTA !sz = \(STA m) ->
+  runST $
+    newSmallArray sz undefinedElem
+      >>= \(SmallMutableArray ar#) -> m ar#
+
+itraverseStepSmallArray :: Applicative f => Int -> Int -> (Int -> a -> f b) -> SmallArray a -> f (SmallArray b)
+itraverseStepSmallArray i0 step f = \ !arr -> do
+  let len = sizeofSmallArray arr
+      go i k
+        | i == len =
+            pure $ STA $ \marr -> unsafeFreezeSmallArray (SmallMutableArray marr)
+        | (# x #) <- indexSmallArray## arr i =
+            liftA2
+              (\b (STA m) -> STA $ \marr -> writeSmallArray (SmallMutableArray marr) i b >> m marr)
+              (f k x)
+              (go (i + 1) $! k + step)
+  if len == 0
+    then pure emptySmallArray
+    else runSTA len <$> go 0 i0
+{-# INLINE [1] itraverseStepSmallArray #-}
+
+{-# RULES
+"itraverseStepSmallArray/ST" forall i0 step (f :: Int -> a -> ST s b).
+  itraverseStepSmallArray i0 step f =
+    itraverseStepSmallArrayP i0 step f
+"itraverseStepSmallArray/IO" forall i0 step (f :: Int -> a -> IO b).
+  itraverseStepSmallArray i0 step f =
+    itraverseStepSmallArrayP i0 step f
+"itraverseStepSmallArray/Id" forall i0 step (f :: Int -> a -> Identity b).
+  itraverseStepSmallArray i0 step f =
+    ( coerce ::
+        (SmallArray a -> SmallArray (Identity b)) ->
+        SmallArray a ->
+        Identity (SmallArray b)
+    )
+      (imapStepSmallArray i0 step f)
+  #-}
+
+-- | This is the fastest, most straightforward way to traverse
+-- an array, but it only works correctly with a sufficiently
+-- "affine" 'PrimMonad' instance. In particular, it must only produce
+-- /one/ result array. 'Control.Monad.Trans.List.ListT'-transformed
+-- monads, for example, will not work right at all.
+itraverseStepSmallArrayP :: PrimMonad m => Int -> Int -> (Int -> a -> m b) -> SmallArray a -> m (SmallArray b)
+itraverseStepSmallArrayP i0 step f = \ !ary -> do
+  let len = sizeofSmallArray ary
+      go i k marr
+        | i == len = unsafeFreezeSmallArray marr
+        | otherwise = do
+            a <- indexSmallArrayM ary i
+            b <- f k a
+            writeSmallArray marr i b
+            (go (i + 1) $! k + step) marr
+  marr <- newSmallArray len undefinedElem
+  go 0 i0 marr
+{-# INLINE itraverseStepSmallArrayP #-}
diff --git a/src/Data/Vector/Persistent/Internal/Buffer.hs b/src/Data/Vector/Persistent/Internal/Buffer.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Vector/Persistent/Internal/Buffer.hs
@@ -0,0 +1,94 @@
+module Data.Vector.Persistent.Internal.Buffer where
+
+import Control.Monad.Primitive
+import Data.Primitive.SmallArray
+import Data.Vector.Persistent.Internal.Array (shrinkSmallMutableArray_)
+import Prelude hiding (length)
+
+data Buffer s a = Buffer
+  { offset :: !Int,
+    marr :: !(SmallMutableArray s a)
+  }
+
+new :: (PrimMonad m, s ~ PrimState m) => m (Buffer s a)
+new = do
+  marr <- newSmallArray 0 undefinedElem
+  pure Buffer {offset = 0, marr}
+{-# INLINE new #-}
+
+newWithCapacity :: (PrimMonad m, s ~ PrimState m) => Int -> m (Buffer s a)
+newWithCapacity cap = do
+  marr <- newSmallArray cap undefinedElem
+  pure Buffer {offset = 0, marr}
+{-# INLINE newWithCapacity #-}
+
+push :: (PrimMonad m, s ~ PrimState m) => a -> Buffer s a -> m (Buffer s a)
+push a buffer = do
+  buffer' <-
+    if length buffer == capacity buffer
+      then resize buffer
+      else pure buffer
+  writeSmallArray (marr buffer') (length buffer) a
+  pure buffer' {offset = offset buffer' + 1}
+{-# INLINE push #-}
+
+read :: (PrimMonad m, s ~ PrimState m) => Int -> Buffer s a -> m a
+read i Buffer {marr} = readSmallArray marr i
+{-# INLINE read #-}
+
+write :: (PrimMonad m, s ~ PrimState m) => Int -> a -> Buffer s a -> m ()
+write i a Buffer {marr} = writeSmallArray marr i a
+{-# INLINE write #-}
+
+clear :: Buffer s a -> Buffer s a
+clear = shrink 0
+{-# INLINE clear #-}
+
+shrink :: Int -> Buffer s a -> Buffer s a
+shrink i buffer = buffer {offset = i}
+{-# INLINE shrink #-}
+
+unsafeShrink :: (PrimMonad m, s ~ PrimState m) => Int -> Buffer s a -> m (Buffer s a)
+unsafeShrink i Buffer {marr} = do
+  marr <- shrinkSmallMutableArray_ marr i
+  pure Buffer {marr, offset = i}
+{-# INLINE unsafeShrink #-}
+
+capacity :: Buffer s a -> Int
+capacity Buffer {marr} = sizeofSmallMutableArray marr
+{-# INLINE capacity #-}
+
+null :: Buffer s a -> Bool
+null = (0 ==) . length
+
+length :: Buffer s a -> Int
+length = offset
+{-# INLINE length #-}
+
+undefinedElem :: forall a. a
+undefinedElem = error "undefined element"
+{-# NOINLINE undefinedElem #-}
+
+resize :: (PrimMonad m, s ~ PrimState m) => Buffer s a -> m (Buffer s a)
+resize buffer = do
+  if capacity buffer == 0
+    then grow 32 buffer
+    else grow (capacity buffer) buffer
+{-# INLINE resize #-}
+
+grow :: (PrimMonad m, s ~ PrimState m) => Int -> Buffer s a -> m (Buffer s a)
+grow more buffer@Buffer {marr, offset} = do
+  marr' <- newSmallArray (sizeofSmallMutableArray marr + more) undefinedElem
+  copySmallMutableArray marr' 0 marr 0 offset
+  pure buffer {marr = marr'}
+{-# INLINE grow #-}
+
+freeze :: (PrimMonad m, s ~ PrimState m) => Buffer s a -> m (SmallArray a)
+freeze Buffer {marr, offset} = freezeSmallArray marr 0 offset
+{-# INLINE freeze #-}
+
+unsafeFreeze :: (PrimMonad m, s ~ PrimState m) => Buffer s a -> m (SmallArray a)
+unsafeFreeze Buffer {marr, offset} = do
+  marr <- shrinkSmallMutableArray_ marr offset
+  unsafeFreezeSmallArray marr
+{-# INLINE unsafeFreeze #-}
diff --git a/src/Data/Vector/Persistent/Internal/CoercibleUtils.hs b/src/Data/Vector/Persistent/Internal/CoercibleUtils.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Vector/Persistent/Internal/CoercibleUtils.hs
@@ -0,0 +1,37 @@
+module Data.Vector.Persistent.Internal.CoercibleUtils where
+
+import Data.Coerce (Coercible, coerce)
+
+-- | Coercive left-composition.
+--
+-- >>> (All #. not) True
+-- All {getAll = False}
+--
+-- The semantics with respect to bottoms are:
+--
+-- @
+-- p '#.' ⊥ ≡ ⊥
+-- p '#.' f ≡ p '.' f
+-- @
+infixr 9 #.
+
+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
+(#.) _ = coerce
+{-# INLINE (#.) #-}
+
+-- | Coercive right-composition.
+--
+-- >>> (stimes 2 .# Product) 3
+-- Product {getProduct = 9}
+--
+-- The semantics with respect to bottoms are:
+--
+-- @
+-- ⊥ '.#' p ≡ ⊥
+-- f '.#' p ≡ p '.' f
+-- @
+infixr 9 .#
+
+(.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c
+(.#) f _ = coerce f
+{-# INLINE (.#) #-}
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,9 @@
+{-# LANGUAGE MagicHash #-}
+
+module Data.Vector.Persistent.Unsafe
+  ( unsafeIndex,
+    unsafeIndex#,
+  )
+where
+
+import Data.Vector.Persistent.Internal
diff --git a/test/PersistentVectorSpec.hs b/test/PersistentVectorSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/PersistentVectorSpec.hs
@@ -0,0 +1,132 @@
+module PersistentVectorSpec (spec) where
+
+import Data.Foldable (foldl')
+import Data.Function ((&))
+import Data.Primitive.SmallArray
+import Data.Vector.Persistent (Vector)
+import qualified Data.Vector.Persistent.Internal as Vector
+import Data.Vector.Persistent.Internal.Array
+import GHC.Exts (fromList, toList)
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+
+spec :: Spec
+spec = parallel $ do
+  prop "toList fromList identity" $ \(l :: [Int]) ->
+    l === toList (fromList @(Vector _) l)
+
+  prop "fmap" fmapProp
+
+  prop "foldr" $ \(l :: [Int]) ->
+    foldr (:) [] l === foldr (:) [] (fromList @(Vector _) l)
+
+  prop "foldl" $ \(l :: [Int]) ->
+    foldl (flip (:)) [] l === foldl (flip (:)) [] (fromList @(Vector _) l)
+
+  it "update bad" $
+    propUpdate
+      64
+      0
+      ((repeat 0 & take 64) ++ [1] ++ (repeat 0 & take 32))
+
+  -- this is somehow broken
+  prop "update" propUpdate
+  -- prop "update" $ \(ix :: Int) (a :: Int) (l :: [Int]) ->
+  --   ix >= 0 ==> do
+  --     let arr = fromList @(Array _) l
+  --         arr'
+  --           | ix >= sizeofSmallArray arr = arr
+  --           | otherwise = updateSmallArray arr ix a
+  -- toList arr' == toList (Vector.update ix a $ fromList @(Vector _) l)
+
+  prop "traverse" $ \(l :: [Int]) -> do
+    let go a = ([a], a)
+    fmap toList (traverse go (fromList @(Vector _) l)) === traverse go l
+
+  prop "index" indexProp
+
+  it "index weierd" $ indexProp 9 [1 :: Int .. 15]
+
+  prop "eq self" $ \(l :: [Int]) ->
+    fromList @(Vector _) l === fromList l
+
+  prop "eq" $ \(l :: [Int]) (l' :: [Int]) ->
+    (l == l') === (fromList @(Vector _) l == fromList @(Vector _) l')
+
+  prop "mappend" $ \(l :: [Int]) (l' :: [Int]) ->
+    l <> l' === toList (fromList @(Vector _) l <> fromList @(Vector _) l')
+
+  it "unsnoc bad" $ unsnocProp (replicate 65 0) 1
+
+  prop "unsnoc" unsnocProp
+
+  prop "snoc unsnoc" snocUnsnocProp
+
+  describe "indexed" $ do
+    prop "imap" $ \(l :: [Int]) ->
+      zip [0 :: Int ..] l === toList (Vector.imap (,) (fromList @(Vector _) l))
+
+propUpdate :: Int -> Int -> [Int] -> Property
+propUpdate ix a l =
+  ix >= 0 ==> do
+    let arr = fromList @(Array _) l
+        arr'
+          | ix >= sizeofSmallArray arr = arr
+          | otherwise = updateSmallArray arr ix a
+    toList arr' === toList (Vector.update ix a $ fromList @(Vector _) l)
+
+fmapProp :: [Int] -> Property
+fmapProp l = do
+  let vec = fmap (+ 20) (fromList @(Vector _) l)
+      res = toList vec
+  map (+ 20) l === res
+
+snocUnsnocProp :: Int -> Bool
+snocUnsnocProp times = do
+  Vector.null
+    . unsnocTimes
+    . snocTimes
+    . unsnocTimes
+    . snocTimes
+    $ Vector.empty
+  where
+    snocTimes vec = foldl' Vector.snoc vec [1 .. times]
+    unsnocTimes vec = foldl' (\vec _ -> unsnoc' vec) vec [1 .. times]
+
+unsnocProp :: [Int] -> Int -> Property
+unsnocProp l i = do
+  let l' = reverse $ drop i $ reverse l
+      vec = fromList @(Vector _) l
+      vec' =
+        foldl'
+          ( \vec _ -> case Vector.unsnoc vec of
+              Nothing -> Vector.empty
+              Just (vec, _) -> vec
+          )
+          vec
+          [1 .. i]
+  l' === toList vec'
+
+unsnoc' :: Vector a -> Vector a
+unsnoc' vec = case Vector.unsnoc vec of
+  Just (vec, _) -> vec
+  _ -> error "empty vector"
+
+indexProp :: Int -> [Int] -> Property
+indexProp ix l = do
+  let indexMaybeList :: [a] -> Int -> Maybe a
+      indexMaybeList xs n
+        | n < 0 = Nothing
+        -- Definition adapted from GHC.List
+        | otherwise =
+            foldr
+              ( \x r k -> case k of
+                  0 -> Just x
+                  _ -> r (k - 1)
+              )
+              (const Nothing)
+              xs
+              n
+      vec = fromList @(Vector _) l
+  indexMaybeList l ix === Vector.lookup ix vec
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}