diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for bytearray
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Andrew Martin (c) 2018
+
+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 Andrew Martin 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,1 @@
+# bytearray
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/Main.hs b/bench/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/Main.hs
@@ -0,0 +1,98 @@
+{-# OPTIONS_GHC -O2 -Wall #-}
+
+import Gauge (bgroup,bench,whnf)
+import Gauge.Main (defaultMain)
+import Packed.Bytes.Small (ByteArray)
+import Packed.Text (Text)
+import Packed.Bytes (Bytes)
+
+import qualified Packed.Bytes.Small as BA
+import qualified Packed.Text as T
+import qualified GHC.OldList as L
+
+main :: IO ()
+main = do
+  defaultMain
+    [ bgroup "ByteArray"
+      [ bench "findByte" $ whnf (BA.findByte 0x80) byteArrayA
+      , bench "zipAnd" $ whnf (BA.zipAnd byteArrayA) byteArrayB
+      ]
+    , bgroup "Text"
+      [ bgroup "toUpper"
+        -- Not totally fair. The number 5000 refers to the character count,
+        -- meaning that asian scripts end up with more bytes.
+        [ bench "ascii" $ whnf T.toUpper textAscii5000
+        , bench "latin" $ whnf T.toUpper textLatin5000
+        , bench "asian" $ whnf T.toUpper textAsian5000
+        ]
+      , bgroup "decodeUtf8"
+        [ bench "ascii" $ whnf T.decodeUtf8 encodedAscii5000
+        , bench "latin" $ whnf T.decodeUtf8 encodedLatin5000
+        , bench "asian" $ whnf T.decodeUtf8 encodedAsian5000
+        ]
+      ]
+    ]
+
+byteArrayA :: ByteArray
+byteArrayA = BA.pack $ L.concat
+  [ L.take 5000 (L.cycle (enumFromTo 0x00 0x7F))
+  , [0x80]
+  , L.take 2000 (L.cycle (enumFromTo 0xB0 0xFF))
+  ]
+
+byteArrayB :: ByteArray
+byteArrayB = BA.pack $ L.concat
+  [ L.take 2000 (L.cycle (enumFromTo 0x80 0xFF))
+  , [0x70]
+  , L.take 3000 (L.cycle (enumFromTo 0x20 0x60))
+  ]
+
+encodedAscii5000 :: Bytes
+encodedAscii5000 = T.encodeUtf8 textAscii5000
+
+encodedLatin5000 :: Bytes
+encodedLatin5000 = T.encodeUtf8 textLatin5000
+
+encodedAsian5000 :: Bytes
+encodedAsian5000 = T.encodeUtf8 textAsian5000
+
+textAscii5000 :: Text
+textAscii5000 = T.pack $ L.concat
+  [ L.take 2000 (L.cycle (enumFromTo 'a' 'm' ++ [','] ++ enumFromTo 'A' 'H' ++ ['.']))
+  , L.take 3000 (L.cycle "The Old Tavern Across The Town")
+  ]
+
+textLatin5000 :: Text
+textLatin5000 = T.pack $ L.take 5000 $ L.cycle $ L.concat
+  [ "Suzanne et Joseph étaient nés dans les deux premières années de leur. "
+  , "arrivée à la colonie. Après la naissance de Suzanne, la mère abandonna "
+  , "l'enseignement d'état. "
+  , "Mentiría si dijera que era del todo nuevo el sentimiento de que ya no "
+  , "iba a poder ser más que lo que era, que era un hombre que había "
+  , "envejecido más de lo que suponía, que había sospechado tener toda "
+  , "la vida por delante y había ido dejando pasar los años a la espera "
+  , "de que llegara su momento, y ahora la tenía a su espalda. "
+  ]
+
+textAsian5000 :: Text
+textAsian5000 = T.pack $ L.take 5000 $ L.cycle $ L.concat
+  [ "유구한 역사와 전통에 빛나는 우리 대한 국민은 3·1 운동으로 건립된 "
+  , "대한민국 임시 정부의 법통과 불의에 항거한 4·19 민주 이념을 계승하고, "
+  , "조국의 민주 개혁과 평화적 통일의 사명에 입각하여 정의·인도와 동포애로써 "
+  , "민족의 단결을 공고히 하고, 모든 사회적 폐습과 불의를 타파하며, 자율과 "
+  , "조화를 바탕으로 자유 민주적 기본 질서를 더욱 확고히 하여 정치·경제·사회·문화의 "
+  , "모든 영역에 있어서 각인의 기회를 균등히 하고, 능력을 최고도로 발휘하게 하며, "
+  , "자유와 권리에 따르는 책임과 의무를 완수하게 하여, 안으로는 국민 생활의 균등한 "
+  , "향상을 기하고 밖으로는 항구적인 세계 평화와 인류 공영에 이바지함으로써 우리들과 "
+  , "우리들의 자손의 안전과 자유와 행복을 영원히 확보할 것을 다짐하면서 1948년 7월 12일에 "
+  , "제정되고 8차에 걸쳐 개정된 헌법을 이제 국회의 의결을 거쳐 국민 투표에 의하여 개정한다."
+  ]
+
+-- textFrench :: Text
+-- textFrench = T.pack $ L.concat
+--   [ "Suzanne et Joseph étaient nés dans les deux premières années de leur. "
+--   , "arrivée à la colonie. Après la naissance de Suzanne, la mère abandonna "
+--   , "l'enseignement d'état. "
+--   ]
+  
+
diff --git a/packed.cabal b/packed.cabal
new file mode 100644
--- /dev/null
+++ b/packed.cabal
@@ -0,0 +1,61 @@
+name: packed
+version: 0.1.0
+description: Please see the README on Github at <https://github.com/andrewthad/bytearray#readme>
+homepage: https://github.com/andrewthad/bytearray#readme
+bug-reports: https://github.com/andrewthad/bytearray/issues
+author: Andrew Martin
+maintainer: andrew.thaddeus@gmail.com
+copyright: 2017 Andrew Martin
+license: BSD3
+license-file: LICENSE
+build-type: Simple
+cabal-version: >= 1.10
+
+extra-source-files:
+  ChangeLog.md
+  README.md
+
+source-repository head
+  type: git
+  location: https://github.com/andrewthad/bytearray
+
+library
+  hs-source-dirs: src
+  build-depends:
+      base >=4.10 && <5
+    , ghc-prim >= 0.5.1.1 && < 0.6
+    , primitive >= 0.6 && < 0.7
+  exposed-modules:
+    Packed.Bytes
+    Packed.Bytes.Window
+    Packed.Bytes.Mutable
+    Packed.Bytes.Small
+    Packed.Text
+    Packed.Text.Small
+  default-language: Haskell2010
+
+test-suite test
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  hs-source-dirs:
+      test
+  build-depends:
+      base >=4.7 && <5
+    , packed
+    , hedgehog >= 0.5
+    , tasty-hedgehog >= 0.1.0.2
+    , tasty-hunit >= 0.9
+    , tasty >= 1.0
+    , containers >= 0.5.10
+    , ghc-prim
+  default-language: Haskell2010
+
+benchmark bench
+  type: exitcode-stdio-1.0
+  build-depends:
+      base
+    , packed
+    , gauge
+  default-language: Haskell2010
+  hs-source-dirs: bench
+  main-is: Main.hs
diff --git a/src/Packed/Bytes.hs b/src/Packed/Bytes.hs
new file mode 100644
--- /dev/null
+++ b/src/Packed/Bytes.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE BangPatterns #-}
+
+{-# OPTIONS_GHC
+ -Weverything
+ -fno-warn-unsafe
+ -fno-warn-implicit-prelude
+ -fno-warn-missing-import-lists
+ -O2
+#-}
+
+module Packed.Bytes
+  ( Bytes(..)
+  , pack
+  , unpack
+  , drop
+  , dropEnd
+  , replicate
+  , length
+  , foldl'
+  , take
+  , empty
+  , findByte
+    -- * Characters
+  , isAscii
+  ) where
+
+import Prelude hiding (take,length,replicate,drop)
+
+import Packed.Bytes.Small (ByteArray(..))
+import Data.Word (Word8)
+import qualified Packed.Bytes.Window as BAW
+import qualified Packed.Bytes.Small as BA
+
+data Bytes = Bytes
+  {-# UNPACK #-} !ByteArray -- payload
+  {-# UNPACK #-} !Int -- offset
+  {-# UNPACK #-} !Int -- length
+
+instance Eq Bytes where
+  Bytes arrA offA lenA == Bytes arrB offB lenB =
+    if lenA == lenB
+      then BAW.equality offA offB lenA arrA arrB
+      else False
+
+pack :: [Word8] -> Bytes
+pack bs = let arr = BA.pack bs in Bytes arr 0 (BA.length arr)
+
+unpack :: Bytes -> [Word8]
+unpack (Bytes arr off len) = go off
+  where
+  go :: Int -> [Word8]
+  go !ix = if ix < len + off
+    then BA.unsafeIndex arr ix : go (ix + 1)
+    else []
+
+drop :: Int -> Bytes -> Bytes
+drop n (Bytes arr off len) = if len > n
+  then Bytes arr (off + n) (len - n)
+  else empty
+
+dropEnd :: Int -> Bytes -> Bytes
+dropEnd n (Bytes arr off len) = if len > n
+  then Bytes arr off (len - n)
+  else empty
+
+replicate :: Int -> Word8 -> Bytes
+replicate len w = fromByteArray (BA.replicate len w)
+
+fromByteArray :: ByteArray -> Bytes
+fromByteArray ba = Bytes ba 0 (BA.length ba)
+
+length :: Bytes -> Int
+length (Bytes _ _ len) = len
+
+findByte :: Word8 -> Bytes -> Maybe Int
+findByte !w (Bytes arr off len) = case BAW.findByte off len w arr of
+  Just ix -> Just (ix - off)
+  Nothing -> Nothing
+
+foldl' :: (a -> Word8 -> a) -> a -> Bytes -> a
+foldl' f !acc0 (Bytes arr off len) = BAW.foldl' off len f acc0 arr
+
+take :: Int -> Bytes -> Bytes
+take !n (Bytes arr off len) = if n < len
+  then Bytes arr off (len - n)
+  else empty
+
+empty :: Bytes
+empty = Bytes BA.empty 0 0
+
+isAscii :: Bytes -> Bool
+isAscii (Bytes arr off len) = BAW.isAscii off len arr
+
+-- In this implementation, we overallocate on each side to
+-- make things line up with machine word boundaries. This
+-- make the reversal eight times faster.
+-- reverse :: Bytes -> Bytes
+-- reverse (Bytes arr off len) =
+--   let !leftWordIx = quot off (PM.sizeOf (undefined :: Word))
+--       !rightWordIx = quot (off + len) (PM.sizeOf (undefined :: Word))
+
diff --git a/src/Packed/Bytes/Mutable.hs b/src/Packed/Bytes/Mutable.hs
new file mode 100644
--- /dev/null
+++ b/src/Packed/Bytes/Mutable.hs
@@ -0,0 +1,1 @@
+module Packed.Bytes.Mutable where
diff --git a/src/Packed/Bytes/Small.hs b/src/Packed/Bytes/Small.hs
new file mode 100644
--- /dev/null
+++ b/src/Packed/Bytes/Small.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# OPTIONS_GHC
+ -Weverything
+ -fno-warn-unsafe
+ -fno-warn-implicit-prelude
+ -fno-warn-missing-import-lists
+ -O2
+#-}
+
+module Packed.Bytes.Small
+  ( ByteArray(..)
+  , empty
+  , pack
+  , unpack
+  , singleton
+  , append
+  , replicate
+  , length
+  , findByte
+  , foldl'
+  , take
+  , cons
+  , uncons
+  , reverse
+    -- * Zip
+  , zipAnd
+  , zipOr
+  , zipXor
+    -- * Characters
+  , isAscii
+    -- * Unsafe
+  , unsafeIndex
+  ) where
+
+import Prelude hiding (replicate,length,take,reverse)
+
+import Control.Monad.Primitive (primitive_)
+import Control.Monad.ST (runST,ST)
+import Data.Primitive.ByteArray (ByteArray(..),MutableByteArray(..))
+import GHC.Exts (setByteArray#,word2Int#,byteSwap#)
+import GHC.Int (Int(I#))
+import GHC.Word (Word8(W8#),Word(W#))
+import qualified GHC.OldList as L
+import qualified Packed.Bytes.Window as BAW
+import qualified Data.Primitive as PM
+
+singleton :: Word8 -> ByteArray
+singleton w = runST $ do
+  marr <- PM.newByteArray 1
+  PM.writeByteArray marr 0 w
+  PM.unsafeFreezeByteArray marr
+
+pack :: [Word8] -> ByteArray
+pack ws0 = runST $ do
+  marr <- PM.newByteArray (L.length ws0)
+  let go [] !_ = return ()
+      go (w : ws) !ix = writeByteArrayWord8 marr ix w >> go ws (ix + 1)
+  go ws0 0
+  PM.unsafeFreezeByteArray marr
+
+unpack :: ByteArray -> [Word8]
+unpack arr = go 0 where
+  go :: Int -> [Word8]
+  go !ix = if ix < length arr
+    then unsafeIndex arr ix : go (ix + 1)
+    else []
+
+append :: ByteArray -> ByteArray -> ByteArray
+append !a !b = do
+  let !lenA = length a
+      !lenB = length b
+      !len = lenA + lenB
+   in runST $ do
+        !marr <- PM.newByteArray len
+        PM.copyByteArray marr 0 a 0 lenA
+        PM.copyByteArray marr lenA b 0 lenB
+        PM.unsafeFreezeByteArray marr
+
+cons :: Word8 -> ByteArray -> ByteArray
+cons w arr = runST $ do
+  let !lenArr = length arr
+  marr <- PM.newByteArray (lenArr + 1)
+  PM.writeByteArray marr 0 w
+  PM.copyByteArray marr 1 arr 0 lenArr
+  PM.unsafeFreezeByteArray marr
+
+uncons :: ByteArray -> Maybe (Word8, ByteArray)
+uncons arr0 = if lenArr > 0
+  then
+    let !arr1 = runST $ do
+          marr <- PM.newByteArray (lenArr - 1)
+          PM.copyByteArray marr 0 arr0 1 (lenArr - 1)
+          PM.unsafeFreezeByteArray marr
+        w :: Word8
+        !w = PM.indexByteArray arr0 0
+     in Just (w,arr1)
+  else Nothing
+  where
+  !lenArr = length arr0
+
+replicate :: Int -> Word8 -> ByteArray
+replicate len@(I# len#) (W8# w#) = runST $ do
+  marr@(MutableByteArray marr#) <- PM.newByteArray len
+  primitive_ (setByteArray# marr# 0# len# (word2Int# w#))
+  PM.unsafeFreezeByteArray marr
+
+length :: ByteArray -> Int
+length = PM.sizeofByteArray
+
+findByte :: Word8 -> ByteArray -> Maybe Int
+findByte !w !arr = BAW.findByte 0 (length arr) w arr
+
+foldl' :: (a -> Word8 -> a) -> a -> ByteArray -> a
+foldl' f !acc0 !arr = BAW.foldl' 0 (length arr) f acc0 arr
+
+take :: Int -> ByteArray -> ByteArray
+take !n !arr = if n < length arr
+  then runST $ do
+    marr <- PM.newByteArray n
+    PM.copyByteArray marr 0 arr 0 n
+    PM.unsafeFreezeByteArray marr
+  else empty
+
+empty :: ByteArray
+empty = runST (PM.newByteArray 0 >>= PM.unsafeFreezeByteArray)
+
+-- | Reverse the bytes in a byte array. This operation is eight
+--   times faster if the length of the byte array divides eight
+--   evenly.
+reverse :: ByteArray -> ByteArray
+reverse !arr = runST $ do
+  marr <- PM.newByteArray (length arr)
+  let !(!quotient,!remainder) = quotRem (length arr) (PM.sizeOf (undefined :: Word))
+  if remainder == 0
+    then goFast 0 quotient marr
+    else goSlow 0 (length arr) marr
+  PM.unsafeFreezeByteArray marr
+  where
+  goFast :: forall s. Int -> Int -> MutableByteArray s -> ST s ()
+  goFast !ix !len !marr = if ix < len
+    then do
+      let !w = unsafeIndexWord arr ix
+      writeByteArrayWord marr (len - ix) (byteSwap w)
+      goFast (ix + 1) len marr
+    else return ()
+  goSlow :: forall s. Int -> Int -> MutableByteArray s -> ST s ()
+  goSlow !ix !len !marr = if ix < len
+    then do
+      let !w = unsafeIndex arr ix
+      writeByteArrayWord8 marr (len - ix) w
+      goSlow (ix + 1) len marr
+    else return ()
+
+byteSwap :: Word -> Word
+byteSwap (W# w) = W# (byteSwap# w)
+
+writeByteArrayWord :: MutableByteArray s -> Int -> Word -> ST s ()
+writeByteArrayWord = PM.writeByteArray
+
+writeByteArrayWord8 :: MutableByteArray s -> Int -> Word8 -> ST s ()
+writeByteArrayWord8 = PM.writeByteArray
+
+-- this is only used internally
+unsafeIndexWord :: ByteArray -> Int -> Word
+unsafeIndexWord = PM.indexByteArray
+
+-- | Does not check to see if the index is in bounds.
+unsafeIndex :: ByteArray -> Int -> Word8
+unsafeIndex = PM.indexByteArray
+
+zipAnd :: ByteArray -> ByteArray -> ByteArray
+zipAnd x y = BAW.zipAnd 0 (length x) 0 (length y) x y
+
+zipOr :: ByteArray -> ByteArray -> ByteArray
+zipOr x y = BAW.zipOr 0 (length x) 0 (length y) x y
+
+zipXor :: ByteArray -> ByteArray -> ByteArray
+zipXor x y = BAW.zipXor 0 (length x) 0 (length y) x y
+
+isAscii :: ByteArray -> Bool
+isAscii x = BAW.isAscii 0 (length x) x
diff --git a/src/Packed/Bytes/Window.hs b/src/Packed/Bytes/Window.hs
new file mode 100644
--- /dev/null
+++ b/src/Packed/Bytes/Window.hs
@@ -0,0 +1,517 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+{-# OPTIONS_GHC
+ -Weverything
+ -fno-warn-unsafe
+ -fno-warn-implicit-prelude
+ -O2
+#-}
+
+module Packed.Bytes.Window
+  ( findByte
+  , foldl'
+  , reverse
+  , zipAnd
+  , zipOr
+  , zipXor
+  , equality
+    -- * Characters
+  , isAscii
+  , isUtf8
+  , findNonAscii'
+  ) where
+
+import Data.Primitive (ByteArray(ByteArray))
+import Data.Word (Word8)
+import GHC.Types (RuntimeRep,TYPE)
+import GHC.Int (Int(I#))
+import GHC.Word (Word8(W8#),Word(W#))
+import GHC.Exts (Int#,Word#,ByteArray#)
+import Data.Bits (xor,(.|.),(.&.),complement,unsafeShiftL)
+import Control.Monad.ST (ST,runST)
+import qualified Data.Primitive as PM
+
+type Maybe# (a :: TYPE (r :: RuntimeRep)) = (# (# #) | a #)
+
+boxMaybeInt :: Maybe# Int# -> Maybe Int
+boxMaybeInt = \case
+  (# | a #) -> Just (I# a)
+  (# (# #) | #) -> Nothing
+
+unboxInt :: Int -> Int#
+unboxInt (I# i) = i
+
+unboxWord :: Word -> Word#
+unboxWord (W# i) = i
+
+-- | Finds the first occurrence of the given byte.
+{-# INLINE findByte #-}
+findByte :: Int -> Int -> Word8 -> ByteArray -> Maybe Int
+findByte (I# off) (I# len) (W8# w) (ByteArray arr) =
+  boxMaybeInt (findByte' off len w arr)
+
+{-# NOINLINE findByte' #-}
+findByte' :: Int# -> Int# -> Word# -> ByteArray# -> Maybe# Int#
+findByte' !off# !len0# !w0# !arr0# = 
+  let !off = I# off#
+      !len0 = I# len0#
+      !end0 = off + len0
+      !beginMachWord = alignUp off
+      !endMachWord = alignDown end0
+   in if len0 < PM.sizeOf (undefined :: Word)
+        then go off end0
+        else case go off (beginMachWord * PM.sizeOf (undefined :: Word)) of
+          (# | ix #) -> (# | ix #)
+          (# (# #) | #) -> case goMachWord beginMachWord endMachWord (broadcastWord8 w) of
+            (# | ix #) -> (# | ix #)
+            (# (# #) | #) -> case go (endMachWord * PM.sizeOf (undefined :: Word)) end0 of
+              (# | ix #) -> (# | ix #)
+              (# (# #) | #) -> (# (# #) | #)
+  where
+  !w = W8# w0#
+  !arr = ByteArray arr0#
+  go :: Int -> Int -> Maybe# Int#
+  go !ix !end = if ix < end
+    then if PM.indexByteArray arr ix == w
+      then (# | unboxInt ix #)
+      else go (ix + 1) end
+    else (# (# #) | #)
+  -- The start and end index here are given in machine Word elements,
+  -- not Word8 elements.
+  goMachWord :: Int -> Int -> Word -> Maybe# Int#
+  goMachWord !ix !end !artifact = if ix < end
+    then case detectArtifact (unsafeIndexWord arr ix) artifact of
+      0 -> goMachWord (ix + 1) end artifact
+      _ -> go -- this call to go should always return Just
+        (ix * PM.sizeOf (undefined :: Word)) 
+        ((ix + 1) * PM.sizeOf (undefined :: Word))
+    else (# (# #) | #)
+
+-- cast a Word8 index to a machine Word index, rounding up
+alignUp :: Int -> Int
+alignUp i =
+  let !(!quotient,!remainder) = quotRem i (PM.sizeOf (undefined :: Word))
+   in case remainder of
+        0 -> quotient
+        _ -> quotient + 1
+
+-- cast a Word8 index to a machine Word index, rounding down
+alignDown :: Int -> Int
+alignDown i = quot i (PM.sizeOf (undefined :: Word))
+
+broadcastWord8 :: Word8 -> Word
+broadcastWord8 !w0 = go 8 (fromIntegral w0) where
+  go :: Int -> Word -> Word
+  go !n !w = if n < 8 * PM.sizeOf (undefined :: Word)
+    then go (twice n) (unsafeShiftL w n .|. w)
+    else w
+
+twice :: Int -> Int
+twice n = n * 2
+
+-- returns non-zero if a null byte is present in the machine word
+detectNull :: Word -> Word
+detectNull x = (x - repeatHexZeroOne) .&. complement x .&. repeatHexEightZero
+
+detectArtifact :: Word -> Word -> Word
+detectArtifact x artifact = detectNull (applyArtifact x artifact)
+
+applyArtifact :: Word -> Word -> Word
+applyArtifact = xor
+
+repeatHexZeroOne :: Word
+repeatHexZeroOne = div maxBound 255
+
+repeatHexEightZero :: Word
+repeatHexEightZero = 128 * (div maxBound 255 :: Word)
+
+foldl' :: forall a. Int -> Int -> (a -> Word8 -> a) -> a -> ByteArray -> a
+foldl' !off !len f !acc0 !arr = go acc0 off where
+  go :: a -> Int -> a
+  go !acc !ix = if ix < off + len
+    then go (f acc (PM.indexByteArray arr ix)) (ix + 1)
+    else acc
+
+-- this is only used internally
+unsafeIndexWord :: ByteArray -> Int -> Word
+unsafeIndexWord = PM.indexByteArray
+
+safeIndexWord :: ByteArray -> Int -> Word
+safeIndexWord arr ix = if ix < 0 || ix >= (div (PM.sizeofByteArray arr) (PM.sizeOf (undefined :: Word)))
+  then error ("safeIndexWord: " ++ show ix ++ " is out of bounds")
+  else PM.indexByteArray arr ix
+
+-- this is only used internally
+unsafeIndex :: ByteArray -> Int -> Word8
+unsafeIndex = PM.indexByteArray
+
+safeIndex :: ByteArray -> Int -> Word8
+safeIndex arr ix = if ix < 0 || ix >= PM.sizeofByteArray arr
+  then error ("safeIndex: " ++ show ix ++ " is out of bounds")
+  else PM.indexByteArray arr ix
+
+-- TODO: optimize this. We could do a whole Word64 at a
+-- time if the bytearray is pinned. Maybe even if it
+-- isn't pinned.
+-- reverse :: Int -> Int -> ByteArray -> ByteArray
+-- reverse off len arr = runST
+
+-- | Check if the given slice of the two byte arrays
+--   is equal.
+equality :: 
+     Int -- ^ start x
+  -> Int -- ^ start y
+  -> Int -- ^ length
+  -> ByteArray -- ^ array x
+  -> ByteArray -- ^ array y
+  -> Bool
+equality !ixA !ixB !len !arrA !arrB = go 0
+  -- TODO: Replace this with compareByteArrays# once GHC 8.4
+  -- or GHC 8.6 is released. This will be simpler and much
+  -- faster.
+  where
+  go :: Int -> Bool
+  go !ix = if ix < len
+    then if safeIndex arrA (ix + ixA) == safeIndex arrB (ix + ixB)
+      then go (ix + 1)
+      else False
+    else True
+
+{-# INLINE zipVectorizable #-}
+zipVectorizable ::
+     (Word8 -> Word8 -> Word8)
+  -> (Word -> Word -> Word)
+  -> Int -- start x
+  -> Int -- len x
+  -> Int -- start y
+  -> Int -- len y
+  -> ByteArray -- x
+  -> ByteArray -- y
+  -> ByteArray -- z
+zipVectorizable !combine !combineMach !startX !lenX !startY !lenY !x !y = runST action
+  where
+  action :: forall s. ST s ByteArray
+  action = do
+    let !len = min lenX lenY
+    marr <- PM.newByteArray len
+    let !(!quotStartX,!remStartX) = quotRem startX (PM.sizeOf (undefined :: Word))
+        !(!quotStartY,!remStartY) = quotRem startY (PM.sizeOf (undefined :: Word))
+        go :: Int -> Int -> ST s ()
+        go !ix !end = if ix < end
+          then do
+            PM.writeByteArray marr ix (combine (unsafeIndex x (startX + ix)) (unsafeIndex y (startY + ix)))
+            go (ix + 1) end
+          else return ()
+        goMach :: Int -> Int -> ST s ()
+        goMach !ix !end = if ix < end
+          then do
+            PM.writeByteArray marr ix (combineMach (unsafeIndexWord x (quotStartX + ix)) (unsafeIndexWord y (quotStartY + ix)))
+            goMach (ix + 1) end
+          else return ()
+    if remStartX .|. remStartY == 0 -- if they are both zero
+      then do
+        let !lenQuotient = quot len (PM.sizeOf (undefined :: Word))
+        goMach 0 lenQuotient
+        go (lenQuotient * PM.sizeOf (undefined :: Word)) len
+      else go 0 len
+    PM.unsafeFreezeByteArray marr
+
+zipAnd :: Int -> Int -> Int -> Int -> ByteArray -> ByteArray -> ByteArray
+zipAnd x0 xlen y0 ylen x y = zipVectorizable (.&.) (.&.) x0 xlen y0 ylen x y
+
+zipOr :: Int -> Int -> Int -> Int -> ByteArray -> ByteArray -> ByteArray
+zipOr x0 xlen y0 ylen x y = zipVectorizable (.|.) (.|.) x0 xlen y0 ylen x y
+
+zipXor :: Int -> Int -> Int -> Int -> ByteArray -> ByteArray -> ByteArray
+zipXor x0 xlen y0 ylen x y = zipVectorizable (.|.) (.|.) x0 xlen y0 ylen x y
+
+-- this can be used to implement all predicates or any predicates
+{-# INLINE boolVectorizable #-}
+boolVectorizable ::
+     Bool
+  -> (Bool -> Bool -> Bool)
+  -> (Word8 -> Bool)
+  -> (Word -> Bool)
+  -> Int -- start
+  -> Int -- len
+  -> ByteArray
+  -> Bool
+boolVectorizable emptyBool together predicate predicateMach !start !len !arr =
+  let !end0 = start + len
+      !beginMachWord = alignUp start
+      !endMachWord = alignDown end0
+   in if len < PM.sizeOf (undefined :: Word)
+        then go start end0
+        else together
+          (go start (beginMachWord * PM.sizeOf (undefined :: Word)))
+          (together
+            (goMachWord beginMachWord endMachWord)
+            (go (endMachWord * PM.sizeOf (undefined :: Word)) end0)
+          )
+  where
+  go :: Int -> Int -> Bool
+  go !ix !end = if ix < end
+    then together (predicate (PM.indexByteArray arr ix)) (go (ix + 1) end)
+    else emptyBool
+  -- The start and end index here are given in machine Word elements,
+  -- not Word8 elements.
+  goMachWord :: Int -> Int -> Bool
+  goMachWord !ix !end = if ix < end
+    then together (predicateMach (unsafeIndexWord arr ix)) (goMachWord (ix + 1) end)
+    else emptyBool
+
+{-# INLINE findVectorizable #-}
+findVectorizable ::
+     (Word8 -> Bool)
+  -> (Word -> Bool)
+  -> Int -- start
+  -> Int -- len
+  -> ByteArray
+  -> Maybe# Int#
+findVectorizable predicate predicateMach !start !len !arr =
+  let !end0 = start + len
+      !beginMachWord = alignUp start
+      !endMachWord = alignDown end0
+   in if len < PM.sizeOf (undefined :: Word)
+        then go start end0
+        else case go start (beginMachWord * PM.sizeOf (undefined :: Word)) of
+          (# | ix #) -> (# | ix #)
+          (# (# #) | #) -> case goMachWord beginMachWord endMachWord of
+            (# | ix #) -> (# | ix #)
+            (# (# #) | #) -> case go (endMachWord * PM.sizeOf (undefined :: Word)) end0 of
+              (# | ix #) -> (# | ix #)
+              (# (# #) | #) -> (# (# #) | #)
+  where
+  go :: Int -> Int -> Maybe# Int#
+  go !ix !end = if ix < end
+    then case predicate (safeIndex arr ix) of
+      False -> go (ix + 1) end
+      True -> (# | unboxInt ix #)
+    else (# (# #) | #)
+  -- The start and end index here are given in machine Word elements,
+  -- not Word8 elements.
+  goMachWord :: Int -> Int -> Maybe# Int#
+  goMachWord !ix !end = if ix < end
+    then case predicateMach (safeIndexWord arr ix) of
+      False -> goMachWord (ix + 1) end
+      True -> go
+        (ix * PM.sizeOf (undefined :: Word)) 
+        ((ix + 1) * PM.sizeOf (undefined :: Word))
+    else (# (# #) | #)
+
+asciiMask :: Word8
+asciiMask = 0x80
+
+asciiMachMask :: Word
+asciiMachMask = repeatHexEightZero
+
+isAscii :: Int -> Int -> ByteArray -> Bool
+isAscii start len arr = boolVectorizable True (&&)
+  (\w -> w .&. asciiMask == 0)
+  (\w -> w .&. asciiMachMask == 0)
+  start len arr
+
+-- This could be exported but it does not seem generally useful.
+findNonAscii' :: Int -> Int -> ByteArray -> Maybe# Int#
+findNonAscii' !start !len !arr = findVectorizable
+  (\w -> w .&. asciiMask /= 0)
+  (\w -> w .&. asciiMachMask /= 0)
+  start len arr
+
+-- | The meaning of the result sum elements in order:
+--
+--   1. An integer representing the first unparseable byte. This
+--      may be up to three bytes before the actual byte where
+--      the actual problem occurred. The leading byte is given
+--      since that gives recovery mechanisms a reasonable place
+--      to split the Bytes.
+--   2. An empty nullary tuple indicating success with no leftovers
+--   3. A triple of three words. The first word is the total number
+--      of bytes in the multibyte word (only ever 2, 3, or 4). The
+--      second is the number of additional bytes needed (only
+--      ever 1, 2, or 3). The third is the fragment of the character built
+--      so far. It will need to be bit shifted to the left by some
+--      multiple of 6 to be completed.
+--   
+--   The first tuple element is 0 if everything successfully
+--   parsed was acsii and a word with the high bit set to 1
+--   if multi-byte characters were present.
+--   It is 1 if there were surrogates, characters
+--   in the range @U+D800@ to @U+DFFF@, present in the text. If
+--   there are surrogates, it is implied that there are multi-byte
+--   characters, since a surrogate is multi-byte by definition.
+--   The value of this element is still meaningful even if the parse
+--   ultimately fails.
+isUtf8 :: 
+     Int -- start
+  -> Int -- length
+  -> ByteArray -- bytes
+  -> (# Word#, (# Int# | (# #) | (# Word#, Word#, Word# #) #) #)
+isUtf8 !start !len !arr = case findNonAscii' start len arr of
+  (# (# #) | #) -> (# 0##, (# | (# #) | #) #)
+  (# | ix# #) -> case postAsciiIsUtf8 (I# ix#) (len + start - (I# ix#)) arr of
+    (# hasSurrogate, (# ixFailure# | | #) #) -> if I# ix# == I# ixFailure#
+      then (# 0## , (# ixFailure# | | #) #)
+      else (# hasSurrogate, (# ixFailure# | | #) #)
+    (# hasSurrogate, (# | (# #) | #) #) -> (# hasSurrogate, (# | (# #) | #) #)
+    (# hasSurrogate, (# | | (# w1, w2, w3 #) #) #) -> (# hasSurrogate, (# | | (# w1, w2, w3 #) #) #)
+-- Notes on the implementation of isUtf8 There is some careful trickery to
+-- ensure that we always correctly report whether or not we encountered any
+-- multi-byte characters. We initially do a fast run to get as far as we can
+-- on only ascii characters. In this stage, we are able to travel a full
+-- machine word at a time. After this, we switch to a slower byte-by-byte
+-- UTF-8 recognition function.  If this second stage fails on the very first
+-- byte it sees, we report that everything successfully parsed was ascii.
+-- If it fails at any point after this, we report that multibyte characters
+-- were encounter. If it succeeds, we report that we encounter multi-byte
+-- characters. This is accurate because, for it to start running at all,
+-- findNonAscii' must have found something that was not ascii.
+
+-- Note that postAsciiIsUtf8 does not return anything indicating whether or not there
+-- were any multi-byte characters present. This is because, if this function
+-- is called, it should be called with the start index on a non-ascii-encoded
+-- character. This function is not expect to perform well. It shouldn't
+-- allocate memory, but it has to go byte-by-byte through the ByteArray. The
+-- author of this library does not know of a way to vectorize the check
+-- for UTF-8 compliance.
+--
+-- The first element of the response tuple is either 1 or a machine word
+-- with the high bit set to 1. If it is the high bit,
+-- no surrogates were present. If it is 1, surrogates were present.
+-- The second element is a nested unboxed sum with three cases. These
+-- are described in the docs for isUtf8.
+--
+postAsciiIsUtf8 :: 
+     Int -- start
+  -> Int -- length
+  -> ByteArray -- bytes
+  -> (# Word#, (# Int# | (# #) | (# Word#, Word#, Word# #) #) #)
+postAsciiIsUtf8 !start !len !arr = go start binaryOneThenZeroes
+  where
+  !end = start + len
+  go :: Int 
+     -> Word
+     -> (# Word#, (# Int# | (# #) | (# Word#, Word#, Word# #) #) #)
+  go !ix !hasSurrogate = if ix < end
+    then
+      let !firstByte = safeIndex arr ix in
+       if | oneByteChar firstByte -> go (ix + 1) hasSurrogate
+          | twoByteChar firstByte -> if ix + 1 < end
+              then if followingByte (safeIndex arr (ix + 1))
+                then go (ix + 2) hasSurrogate
+                else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+              else (# unboxWord hasSurrogate, (# | | (# 2##, 1##, unboxWord (byteTwoPartialOne firstByte) #) #) #)
+          | threeByteChar firstByte ->
+              if | ix + 2 < end -> 
+                     let !secondByte = safeIndex arr (ix + 1) in
+                     if followingByte secondByte
+                       then 
+                         let !thirdByte = safeIndex arr (ix + 2) in
+                         if followingByte thirdByte
+                           then if surrogate (codepointFromThreeBytes firstByte secondByte thirdByte)
+                             then go (ix + 3) 1
+                             else go (ix + 3) hasSurrogate
+                           else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                       else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                 | ix + 1 < end -> 
+                     let !secondByte = safeIndex arr (ix + 1) in
+                     if followingByte secondByte
+                       then (# unboxWord hasSurrogate, (# | | (# 3##, 1##, unboxWord (byteThreePartialTwo firstByte secondByte) #) #) #)
+                       else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                 | otherwise -> (# unboxWord hasSurrogate, (# | | (# 3##, 2##, unboxWord (byteThreePartialOne firstByte) #) #) #)
+          | fourByteChar firstByte ->
+              if | ix + 3 < end ->
+                     let !secondByte = safeIndex arr (ix + 1) in
+                     if followingByte secondByte
+                       then 
+                         let !thirdByte = safeIndex arr (ix + 2) in
+                         if followingByte thirdByte
+                           then
+                             let !fourthByte = safeIndex arr (ix + 3) in
+                             if followingByte fourthByte
+                               then go (ix + 4) hasSurrogate
+                               else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                           else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                       else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                 | ix + 2 < end -> 
+                     let !secondByte = safeIndex arr (ix + 1) in
+                     if followingByte secondByte
+                       then 
+                         let !thirdByte = safeIndex arr (ix + 2) in
+                         if followingByte thirdByte
+                           then (# unboxWord hasSurrogate, (# | | (# 4##, 1##, unboxWord (byteFourPartialThree firstByte secondByte thirdByte) #) #) #)
+                           else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                       else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                 | ix + 1 < end -> 
+                     let !secondByte = safeIndex arr (ix + 1) in
+                     if followingByte secondByte
+                       then (# unboxWord hasSurrogate, (# | | (# 4##, 2##, unboxWord (byteFourPartialTwo firstByte secondByte) #) #) #)
+                       else (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+                 | otherwise -> (# unboxWord hasSurrogate, (# | | (# 4##, 3##, unboxWord (byteFourPartialOne firstByte) #) #) #)
+          | otherwise -> (# unboxWord hasSurrogate, (# unboxInt ix | | #) #)
+    else (# unboxWord hasSurrogate, (# | (# #) | #) #)
+
+byteTwoPartialOne :: Word8 -> Word
+byteTwoPartialOne w = word8ToWord w .&. 0b00011111
+
+byteThreePartialTwo :: Word8 -> Word8 -> Word
+byteThreePartialTwo a b =
+  unsafeShiftL (word8ToWord a .&. 0b00001111) 6 .|.
+  (word8ToWord b .&. 0b00111111)
+
+byteThreePartialOne :: Word8 -> Word
+byteThreePartialOne a = word8ToWord a .&. 0b00001111
+
+byteFourPartialTwo :: Word8 -> Word8 -> Word
+byteFourPartialTwo a b =
+  unsafeShiftL (word8ToWord a .&. 0b00000111) 6 .|.
+  (word8ToWord b .&. 0b00111111)
+
+byteFourPartialThree :: Word8 -> Word8 -> Word8 -> Word
+byteFourPartialThree a b c =
+  unsafeShiftL (word8ToWord a .&. 0b00000111) 12 .|.
+  unsafeShiftL (word8ToWord b .&. 0b00111111) 6 .|.
+  (word8ToWord c .&. 0b00111111)
+
+byteFourPartialOne :: Word8 -> Word
+byteFourPartialOne a = word8ToWord a .&. 0b00000111
+
+followingByte :: Word8 -> Bool
+followingByte !w = xor w 0b01000000 .&. 0b11000000 == 0b11000000
+
+oneByteChar :: Word8 -> Bool
+oneByteChar !w = w .&. 0b10000000 == 0
+
+twoByteChar :: Word8 -> Bool
+twoByteChar !w = w .&. 0b11100000 == 0b11000000
+
+threeByteChar :: Word8 -> Bool
+threeByteChar !w = w .&. 0b11110000 == 0b11100000
+
+fourByteChar :: Word8 -> Bool
+fourByteChar !w = w .&. 0b11111000 == 0b11110000
+
+codepointFromThreeBytes :: Word8 -> Word8 -> Word8 -> Word
+codepointFromThreeBytes w1 w2 w3 = 
+  unsafeShiftL (word8ToWord w1 .&. 0b00001111) 12 .|. 
+  unsafeShiftL (word8ToWord w2 .&. 0b00111111) 6 .|. 
+  (word8ToWord w3 .&. 0b00111111)
+
+word8ToWord :: Word8 -> Word
+word8ToWord = fromIntegral
+
+surrogate :: Word -> Bool
+surrogate codepoint = codepoint >= 0xD800 && codepoint < 0xE000
+
+binaryOneThenZeroes :: Word
+binaryOneThenZeroes = maxBound - div (maxBound :: Word) 2
+
diff --git a/src/Packed/Text.hs b/src/Packed/Text.hs
new file mode 100644
--- /dev/null
+++ b/src/Packed/Text.hs
@@ -0,0 +1,600 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+{-# OPTIONS_GHC
+ -Weverything
+ -fno-warn-unsafe
+ -fno-warn-implicit-prelude
+ -fno-warn-missing-import-lists
+ -O2
+#-}
+
+module Packed.Text
+  ( Text(..)
+  , empty
+  , pack
+  , unpack
+  , breakChar
+  , map
+  , toUpper
+  , take
+  , drop
+  , dropEnd
+  , length
+    -- * Encoding
+  , decodeAscii
+  , decodeResumeAscii
+  , decodeUtf8
+  , decodeResumeUtf8
+  , encodeUtf8
+  ) where
+
+import Prelude hiding (map,take,drop,length)
+import Data.Char (ord,chr)
+import Data.Primitive (MutableByteArray)
+import Packed.Bytes.Small (ByteArray)
+import GHC.Exts (Word#)
+import GHC.Int (Int(I#))
+import GHC.Word (Word(W#),Word8(W8#))
+import Data.Bits ((.&.),(.|.),unsafeShiftR,unsafeShiftL,complement)
+import Control.Monad.ST (ST,runST)
+import Packed.Bytes (Bytes(..))
+import qualified Data.Char
+import qualified Packed.Bytes.Small as BA
+import qualified Packed.Bytes.Window as BAW
+import qualified Packed.Bytes as B
+import qualified Data.Primitive as PM
+
+data Text = Text
+  {-# UNPACK #-} !ByteArray -- payload, normal UTF8-encoded text, nothing special like the unsliced variant
+  {-# UNPACK #-} !Word -- offset in bytes, not in characters, first bit reserved
+  {-# UNPACK #-} !Int -- length in bytes, not in characters
+-- The byte-multiplicity for text is always Multiple if
+-- a multi-byte character is present. If no multi-byte
+-- characters are present, it may be set to either single
+-- or multiple. Functions should try to set it to single
+-- when possible.
+
+instance Eq Text where
+  t1 == t2 = Bytes arr1 off1 len1 == Bytes arr2 off2 len2
+    where
+    !(!arr1,!off1,!len1,!_) = textMatch t1
+    !(!arr2,!off2,!len2,!_) = textMatch t2
+
+instance Show Text where
+  show = show . unpack 
+
+newtype Multiplicity = Multiplicity Word
+  deriving Eq
+
+appendMult :: Multiplicity -> Multiplicity -> Multiplicity
+appendMult (Multiplicity a) (Multiplicity b) = Multiplicity (a .|. b)
+
+single :: Multiplicity
+single = Multiplicity 0
+
+multiple :: Multiplicity
+multiple = Multiplicity binaryOneThenZeroes
+
+pack :: String -> Text
+pack str = case metadata 0 single str of
+  (!totalBytes,!totalMult) -> 
+    let !arr = runST $ do
+          marr <- PM.newByteArray totalBytes
+          let go [] !_ = return ()
+              go (!c : cs) !ix0 = do
+                ix1 <- writeChar c ix0 marr
+                go cs ix1
+          go str 0
+          PM.unsafeFreezeByteArray marr
+     in Text arr (buildZeroOffMult totalMult) totalBytes
+  where
+  metadata :: Int -> Multiplicity -> [Char] -> (Int,Multiplicity)
+  metadata !totalBytes !totalMult [] = (totalBytes,totalMult)
+  metadata !totalBytes !totalMult (!c : cs) =
+    let !bytes = charBytes c
+        !mult = if bytes < 2 then single else multiple
+     in metadata (bytes + totalBytes) (appendMult mult totalMult) cs
+
+-- Result is between 1 and 4. The guards used here do not have to treat
+-- surrogates as a special case.
+charBytes :: Char -> Int
+charBytes !c
+  | codepoint < 0x80 = 1
+  | codepoint < 0x800 = 2
+  | codepoint < 0x10000 = 3
+  | otherwise = 4
+  where
+  !codepoint = intToWord (ord c)
+
+-- returns the new index
+writeChar :: Char -> Int -> PM.MutableByteArray s -> ST s Int
+writeChar !c !ix !marr
+  | codepoint < 0x80 = do
+      PM.writeByteArray marr ix (unsafeWordToWord8 codepoint)
+      return (ix + 1)
+  | codepoint < 0x800 = do
+      PM.writeByteArray marr ix (unsafeWordToWord8 (byteTwoOne codepoint))
+      PM.writeByteArray marr (ix + 1) (unsafeWordToWord8 (byteTwoTwo codepoint))
+      return (ix + 2)
+  | surrogate codepoint = do
+      -- Codepoint U+FFFD
+      PM.writeByteArray marr ix (0xEF :: Word8)
+      PM.writeByteArray marr (ix + 1) (0xBF :: Word8)
+      PM.writeByteArray marr (ix + 2) (0xBD :: Word8)
+      return (ix + 3)
+  | codepoint < 0x10000 = do
+      PM.writeByteArray marr ix (unsafeWordToWord8 (byteThreeOne codepoint))
+      PM.writeByteArray marr (ix + 1) (unsafeWordToWord8 (byteThreeTwo codepoint))
+      PM.writeByteArray marr (ix + 2) (unsafeWordToWord8 (byteThreeThree codepoint))
+      return (ix + 3)
+  | otherwise = do
+      PM.writeByteArray marr ix (unsafeWordToWord8 (byteFourOne codepoint))
+      PM.writeByteArray marr (ix + 1) (unsafeWordToWord8 (byteFourTwo codepoint))
+      PM.writeByteArray marr (ix + 2) (unsafeWordToWord8 (byteFourThree codepoint))
+      PM.writeByteArray marr (ix + 3) (unsafeWordToWord8 (byteFourFour codepoint))
+      return (ix + 4)
+  where
+  !codepoint = intToWord (ord c)
+
+unpack :: Text -> String
+unpack !t = go off
+  where
+  go :: Int -> String
+  go !ix0 = if ix0 < len + off
+    then
+      let !(!ix1,!c) = nextChar arr ix0
+       in c : go ix1
+    else []
+  !(!arr,!off,!len,!_) = textMatch t
+
+nextChar :: ByteArray -> Int -> (Int,Char)
+nextChar !arr !ix
+  | oneByteChar firstByte = (ix + 1, wordToChar (word8ToWord firstByte))
+  | twoByteChar firstByte =
+      let !secondByte = BA.unsafeIndex arr (ix + 1)
+       in (ix + 2, charFromTwoBytes firstByte secondByte)
+  | threeByteChar firstByte =
+      let !secondByte = BA.unsafeIndex arr (ix + 1)
+          !thirdByte = BA.unsafeIndex arr (ix + 2)
+       in (ix + 3, charFromThreeBytes firstByte secondByte thirdByte)
+  | otherwise =
+      let !secondByte = BA.unsafeIndex arr (ix + 1)
+          !thirdByte = BA.unsafeIndex arr (ix + 2)
+          !fourthByte = BA.unsafeIndex arr (ix + 3)
+       in (ix + 4, charFromFourBytes firstByte secondByte thirdByte fourthByte)
+  where
+  firstByte :: Word8
+  !firstByte = BA.unsafeIndex arr ix
+
+nextCharIx :: ByteArray -> Int -> Int
+nextCharIx !arr !ix
+  | oneByteChar firstByte = ix + 1
+  | twoByteChar firstByte = ix + 2
+  | threeByteChar firstByte = ix + 3
+  | otherwise = ix + 4
+  where
+  firstByte :: Word8
+  !firstByte = BA.unsafeIndex arr ix
+
+moveChars ::
+     ByteArray -- array
+  -> Int -- start index
+  -> Int -- maximal index
+  -> Int -- number of characters to move through
+  -> Int -- end index
+moveChars !arr !start0 !maxIndex !n0 = go start0 n0
+  where
+  go :: Int -> Int -> Int
+  go !ix !n = if n > 0 && ix < maxIndex
+    then go (nextCharIx arr ix) (n - 1)
+    else ix
+
+countChars ::
+     ByteArray -- array
+  -> Int -- start index
+  -> Int -- maximal index
+  -> Int -- number of characters 
+countChars !arr !start0 !maxIndex = go start0 0
+  where
+  go :: Int -> Int -> Int
+  go !ix !acc = if ix < maxIndex
+    then go (nextCharIx arr ix) (acc + 1)
+    else acc
+
+oneByteChar :: Word8 -> Bool
+oneByteChar w = w .&. 0b10000000 == 0
+
+twoByteChar :: Word8 -> Bool
+twoByteChar w = w .&. 0b11100000 == 0b11000000
+
+threeByteChar :: Word8 -> Bool
+threeByteChar w = w .&. 0b11110000 == 0b11100000
+
+charFromTwoBytes :: Word8 -> Word8 -> Char
+charFromTwoBytes w1 w2 = wordToChar $
+  unsafeShiftL (word8ToWord w1 .&. 0b00011111) 6 .|. 
+  (word8ToWord w2 .&. 0b00111111)
+
+charFromThreeBytes :: Word8 -> Word8 -> Word8 -> Char
+charFromThreeBytes w1 w2 w3 = wordToChar $
+  unsafeShiftL (word8ToWord w1 .&. 0b00001111) 12 .|. 
+  unsafeShiftL (word8ToWord w2 .&. 0b00111111) 6 .|. 
+  (word8ToWord w3 .&. 0b00111111)
+
+charFromFourBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Char
+charFromFourBytes w1 w2 w3 w4 = wordToChar $
+  unsafeShiftL (word8ToWord w1 .&. 0b00000111) 18 .|. 
+  unsafeShiftL (word8ToWord w2 .&. 0b00111111) 12 .|. 
+  unsafeShiftL (word8ToWord w3 .&. 0b00111111) 6 .|. 
+  (word8ToWord w4 .&. 0b00111111)
+
+-- precondition: codepoint is less than 0x800
+byteTwoOne :: Word -> Word
+byteTwoOne w = unsafeShiftR w 6 .|. 0b11000000
+
+byteTwoTwo :: Word -> Word
+byteTwoTwo w = (w .&. 0b00111111) .|. 0b10000000
+
+-- precondition: codepoint is less than 0x1000
+byteThreeOne :: Word -> Word
+byteThreeOne w = unsafeShiftR w 12 .|. 0b11100000
+
+byteThreeTwo :: Word -> Word
+byteThreeTwo w = (0b00111111 .&. unsafeShiftR w 6) .|. 0b10000000
+
+byteThreeThree :: Word -> Word
+byteThreeThree w = (w .&. 0b00111111) .|. 0b10000000
+
+-- precondition: codepoint is less than 0x110000
+byteFourOne :: Word -> Word
+byteFourOne w = unsafeShiftR w 18 .|. 0b11110000
+
+byteFourTwo :: Word -> Word
+byteFourTwo w = (0b00111111 .&. unsafeShiftR w 12) .|. 0b10000000
+
+byteFourThree :: Word -> Word
+byteFourThree w = (0b00111111 .&. unsafeShiftR w 6) .|. 0b10000000
+
+byteFourFour :: Word -> Word
+byteFourFour w = (0b00111111 .&. w) .|. 0b10000000
+
+
+
+word8ToWord :: Word8 -> Word
+word8ToWord = fromIntegral
+
+intToWord :: Int -> Word
+intToWord = fromIntegral
+
+wordToInt :: Word -> Int
+wordToInt = fromIntegral
+
+unsafeWordToWord8 :: Word -> Word8
+unsafeWordToWord8 (W# w) = W8# w
+
+wordToChar :: Word -> Char
+wordToChar w = chr (fromIntegral w)
+
+empty :: Text
+empty = Text BA.empty 0 0
+
+breakChar :: Char -> Text -> (Text,Text)
+breakChar !c !t
+  | codepoint < 0x80 = breakOnByte1 (unsafeWordToWord8 codepoint) t
+  | codepoint < 0x800 = case findBytePair off len (unsafeWordToWord8 (byteTwoOne codepoint)) (unsafeWordToWord8 (byteTwoTwo codepoint)) arr of
+      Nothing -> (t,empty)
+      Just ix -> (Text arr (buildOffMult off mult) (ix - off), Text arr (buildOffMult ix mult) (len + off - ix))
+  | surrogate codepoint = case findByteTriple off len 0xEF 0xBF 0xBD arr of
+      Nothing -> (t,empty)
+      Just ix -> (Text arr (buildOffMult off mult) (ix - off), Text arr (buildOffMult ix mult) (len + off - ix))
+  | codepoint < 0x10000 = case findByteTriple off len (unsafeWordToWord8 (byteThreeOne codepoint)) (unsafeWordToWord8 (byteThreeTwo codepoint)) (unsafeWordToWord8 (byteThreeThree codepoint)) arr of
+      Nothing -> (t,empty)
+      Just ix -> (Text arr (buildOffMult off mult) (ix - off), Text arr (buildOffMult ix mult) (len + off - ix))
+  | otherwise = case findByteQuadruple off len (unsafeWordToWord8 (byteFourOne codepoint)) (unsafeWordToWord8 (byteFourTwo codepoint)) (unsafeWordToWord8 (byteFourThree codepoint)) (unsafeWordToWord8 (byteFourFour codepoint)) arr of
+      Nothing -> (t,empty)
+      Just ix -> (Text arr (buildOffMult off mult) (ix - off), Text arr (buildOffMult ix mult) (len + off - ix))
+  where
+  !codepoint = intToWord (ord c)
+  !(!arr,!off,!len,!mult) = textMatch t
+
+findBytePair :: Int -> Int -> Word8 -> Word8 -> ByteArray -> Maybe Int
+findBytePair off0 len0 w1 w2 arr = go off0 (off0 + len0 - 1)
+  where
+  go :: Int -> Int -> Maybe Int
+  go !ix !end = if ix < end
+    then if PM.indexByteArray arr ix == w1 && PM.indexByteArray arr (ix + 1) == w2
+      then Just ix
+      else go (ix + 1) end
+    else Nothing
+
+findByteTriple :: Int -> Int -> Word8 -> Word8 -> Word8 -> ByteArray -> Maybe Int
+findByteTriple off0 len0 w1 w2 w3 arr = go off0 (off0 + len0 - 2)
+  where
+  go :: Int -> Int -> Maybe Int
+  go !ix !end = if ix < end
+    then if PM.indexByteArray arr ix == w1 && PM.indexByteArray arr (ix + 1) == w2 && PM.indexByteArray arr (ix + 2) == w3
+      then Just ix
+      else go (ix + 1) end
+    else Nothing
+
+findByteQuadruple :: Int -> Int -> Word8 -> Word8 -> Word8 -> Word8 -> ByteArray -> Maybe Int
+findByteQuadruple off0 len0 w1 w2 w3 w4 arr = go off0 (off0 + len0 - 3)
+  where
+  go :: Int -> Int -> Maybe Int
+  go !ix !end = if ix < end
+    then if PM.indexByteArray arr ix == w1 && PM.indexByteArray arr (ix + 1) == w2 && PM.indexByteArray arr (ix + 2) == w3 && PM.indexByteArray arr (ix + 3) == w4
+      then Just ix
+      else go (ix + 1) end
+    else Nothing
+
+-- precondition: the Word is less than 0x80
+breakOnByte1 :: Word8 -> Text -> (Text,Text)
+breakOnByte1 !w !t =
+  let !(!arr,!off,!len,!mult) = textMatch t
+   in case BAW.findByte off len w arr of
+        Nothing -> (t,empty)
+        Just !ix -> (dwindle (Text arr (buildOffMult off mult) (ix - off)), Text arr (buildOffMult ix mult) (len + off - ix))
+
+dwindle :: Text -> Text
+dwindle t@(Text _ _ !len) = if len > 0 then t else empty
+  
+buildOffMult :: Int -> Multiplicity -> Word
+buildOffMult i (Multiplicity x) = intToWord i .|. x
+
+buildZeroOffMult :: Multiplicity -> Word
+buildZeroOffMult (Multiplicity w) = w
+
+textMatch :: Text -> (ByteArray,Int,Int,Multiplicity)
+textMatch (Text arr offMult len) =
+  ( arr
+  , wordToInt (binaryZeroThenOnes .&. offMult)
+  , len
+  , Multiplicity (offMult .&. binaryOneThenZeroes)
+  )
+
+binaryOneThenZeroes :: Word
+binaryOneThenZeroes = maxBound - div (maxBound :: Word) 2
+
+binaryZeroThenOnes :: Word
+binaryZeroThenOnes = div (maxBound :: Word) 2
+
+surrogate :: Word -> Bool
+surrogate codepoint = codepoint >= 0xD800 && codepoint < 0xE000
+
+-- Each byte in the word that is a lowercase ascii character is turned
+-- into 0x80. All other bytes become 0x00.
+hasAsciiLowerArtifact :: Word -> Word
+hasAsciiLowerArtifact w = 
+  ((div maxBound 255 * (127 + hi)) - (w .&. (div maxBound 255 * 127))) .&. complement w .&.
+  ((w .&. (div maxBound 255 * 127)) + (div maxBound 255 * (127 - lo))) .&. (div maxBound 255 * 128)
+  where
+  lo = intToWord (ord 'a' - 1)
+  hi = intToWord (ord 'z' + 1)
+
+-- TODO: improve this. Currently, we do not use a vectorized implementation if
+-- the string doesn't start aligned on a machine word address. We can fix this
+-- by padding the result to the left to line it up better. This would trade a
+-- small amount of space for more speed.
+{-# INLINE mapVectorizable #-}
+mapVectorizable ::
+     (Word8 -> Word8) -- function
+  -> (Word -> Word) -- vectorized function variant
+  -> Int -- start
+  -> Int -- len
+  -> ByteArray -- array
+  -> ByteArray
+mapVectorizable !func !funcMach !start !len !arr = runST action
+  where
+  action :: forall s. ST s ByteArray
+  action = do
+    marr <- PM.newByteArray len
+    let !(!quotStart,!remStart) = quotRem start (PM.sizeOf (undefined :: Word))
+        go :: Int -> Int -> ST s ()
+        go !ix !end = if ix < end
+          then do
+            PM.writeByteArray marr ix (func (PM.indexByteArray arr (start + ix)))
+            go (ix + 1) end
+          else return ()
+        goMach :: Int -> Int -> ST s ()
+        goMach !ix !end = if ix < end
+          then do
+            PM.writeByteArray marr ix (funcMach (PM.indexByteArray arr (quotStart + ix)))
+            goMach (ix + 1) end
+          else return ()
+    if remStart == 0
+      then do
+        let !lenQuotient = quot len (PM.sizeOf (undefined :: Word))
+        goMach 0 lenQuotient
+        go (lenQuotient * PM.sizeOf (undefined :: Word)) len
+      else go 0 len
+    PM.unsafeFreezeByteArray marr
+
+toUpperAsciiWord8 :: Word8 -> Word8
+toUpperAsciiWord8 w = if word8ToWord w - intToWord (ord 'a') < 26
+  then w - 0x20
+  else w
+
+toUpperAsciiWord :: Word -> Word
+toUpperAsciiWord w = w - unsafeShiftR (hasAsciiLowerArtifact w) 2
+
+toUpperAscii :: Int -> Int -> ByteArray -> ByteArray
+toUpperAscii !off !len !arr = mapVectorizable toUpperAsciiWord8 toUpperAsciiWord off len arr
+
+toUpper :: Text -> Text
+toUpper t = if mult == single
+  then Text (toUpperAscii off len arr) (buildZeroOffMult single) len
+  else map Data.Char.toUpper t
+  where
+  !(!arr,!off,!len,!mult) = textMatch t
+
+map :: (Char -> Char) -> Text -> Text
+map f !t = runST action
+  where
+  !(!arr,!off,!len,!_) = textMatch t
+  action :: ST s Text
+  action = do
+    marr0 <- PM.newByteArray (len + 3)
+    let go :: Int -> Int -> Int -> Multiplicity -> MutableByteArray s -> ST s (Int,MutableByteArray s,Multiplicity)
+        go !ixSrc !ixDst !marrLen !mult !marr = if ixSrc < off + len
+          then do
+            let !(!ixSrcNext,!c) = nextChar arr ixSrc
+                !c' = f c
+                -- It is disappointing that this is handled this
+                -- way. Reconsider this later.
+                !newMult = appendMult mult (if ixSrcNext - ixSrc > 1 then multiple else single)
+            if ixDst < marrLen - 3
+              then do
+                ixDstNext <- writeChar c' ixDst marr
+                go ixSrcNext ixDstNext marrLen newMult marr
+              else do
+                let newMarrLen = marrLen * 2
+                newMarr <- PM.newByteArray newMarrLen
+                PM.copyMutableByteArray newMarr 0 marr 0 marrLen -- possible minus 3?
+                ixDstNext <- writeChar c' ixDst newMarr
+                go ixSrcNext ixDstNext newMarrLen newMult newMarr
+          else return (ixDst,marr,mult)
+    (finalLen,finalMarr,finalMult) <- go off 0 (len + 3) single marr0
+    newArr <- PM.unsafeFreezeByteArray finalMarr
+    return (Text newArr (buildZeroOffMult finalMult) finalLen)
+
+-- | /O(n)/ 'take' @n xs@ returns the prefix of @xs@ of length @n@. It returns
+--   @xs@ instead when @n > 'length' xs@. On text containing only ASCII characters,
+--   the complexity of this function is reduced to /O(1)/.
+take :: Int -> Text -> Text
+take !n !t@(Text _ !offMult _) = if n < 1
+  then empty
+  else if mult == single
+    then if n < len
+      then Text arr offMult n
+      else t
+    else if n < len * 4
+      then Text arr offMult (moveChars arr off (off + len) n - off)
+      else t
+  where
+  !(!arr,!off,!len,!mult) = textMatch t
+
+-- | /O(n)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ characters
+--   have been removed. It returns @empty@ instead when @n > 'length' xs@. On text
+--   containing only ASCII characters, the complexity of this function is reduced to /O(1)/.
+drop :: Int -> Text -> Text
+drop !n !t = if n < 1
+  then t
+  else if mult == single
+    then if n < len
+      then Text arr (buildOffMult (off + n) mult) (len - n)
+      else empty
+    else if n < len * 4
+      then
+        let !skipped = moveChars arr off (off + len) n - off
+         in Text arr (buildOffMult (off + skipped) mult) (len - skipped)
+      else empty
+  where
+  !(!arr,!off,!len,!mult) = textMatch t
+
+length :: Text -> Int
+length !t = if mult == single
+  then len
+  else countChars arr off (off + len)
+  where
+  !(!arr,!off,!len,!mult) = textMatch t
+
+-- | /O(n)/ 'dropEnd' @n xs@ returns the prefix of @xs@ after the last @n@ characters
+--   have been removed. It returns @empty@ instead when @n > 'length' xs@. On text
+--   containing only ASCII characters, the complexity of this function is reduced to /O(1)/.
+dropEnd :: Int -> Text -> Text
+-- Note: There is a way to implement this that is more efficient. It would
+-- required scanning UTF-8 encoded text backwards, which seems annoying
+-- to do.
+dropEnd !n !t = take (length t - n) t
+
+decodeAscii :: Bytes -> Maybe Text
+decodeAscii b = case decodeResumeAscii b of
+  (# t, (# | (# #) #) #) -> Just t
+  (# !_, (# !_ | #) #) -> Nothing
+-- decodeAscii b@(Bytes arr off len) = if B.isAscii b
+--   then Just (Text arr (buildOffMult off single) len)
+--   else Nothing
+
+decodeResumeAscii :: Bytes -> (# Text, (# Bytes | (# #) #) #)
+decodeResumeAscii (Bytes arr off len) = case BAW.findNonAscii' off len arr of
+  (# (# #) | #) -> (# Text arr (buildOffMult off single) len, (# | (# #) #) #)
+  (# | ix# #) -> 
+    let ix = I# ix#
+     in (# Text arr (buildOffMult off single) ix, (# (Bytes arr ix (len + off - ix)) | #) #)
+
+decodeUtf8 :: Bytes -> Maybe Text
+decodeUtf8 b = case decodeResumeUtf8 b of
+  (# !_, (# !_ | | #) #) -> Nothing
+  (# !t, (# | (# #) | #) #) -> Just t
+  (# !_, (# | | !_ #) #) -> Nothing
+
+-- decodeUtf8 :: Bytes -> Maybe Text
+-- decodeUtf8 b = case decodeResumeUtf8 b of
+--   (# !_, West !_ #) -> Nothing
+--   (# !t, Center () #) -> Just t
+--   (# !_, East !_ #) -> Nothing
+
+data Choice a b c = West a | Center b | East c
+
+decodeResumeUtf8 ::
+     Bytes
+  -> (# Text, (# Bytes | (# #) | (# Word#, Word#, Word# #) #) #)
+decodeResumeUtf8 (Bytes arr off len) = 
+  let !(# !ascii, !r #) = BAW.isUtf8 off len arr
+      !modifiedArr = case ascii of
+        1## -> runST $ do
+          marr <- PM.newByteArray len
+          PM.copyByteArray marr 0 arr off len
+          replaceSurrogates 0 len marr
+          PM.unsafeFreezeByteArray marr
+        _ -> arr
+      !mult = case ascii of
+        1## -> multiple
+        _ -> Multiplicity (W# ascii)
+   in case r of
+        (# ixFailure# | | #) -> 
+          let !ixFailure = I# ixFailure#
+           in (# Text modifiedArr (buildOffMult off mult) ixFailure, (# (Bytes arr ixFailure (len + off - ixFailure)) | | #) #)
+        (# | (# #) | #) -> (# Text modifiedArr (buildOffMult off mult) len, (# | (# #) | #) #)
+        (# | | (# w1, w2, w3 #) #) -> (# Text modifiedArr (buildOffMult off mult) len , (# | | (# w1, w2, w3 #) #) #)
+
+replaceSurrogates :: forall s. Int -> Int -> MutableByteArray s -> ST s ()
+replaceSurrogates start len marr = go start where
+  go :: Int -> ST s ()
+  go !ix = if ix < len - 2
+    then do
+      !w1 <- PM.readByteArray marr ix
+      !w2 <- PM.readByteArray marr (ix + 1)
+      !w3 <- PM.readByteArray marr (ix + 2)
+      if threeByteChar w1 && surrogate (codepointFromThreeBytes w1 w2 w3)
+        then do
+          -- Codepoint U+FFFD
+          PM.writeByteArray marr ix (0xEF :: Word8)
+          PM.writeByteArray marr (ix + 1) (0xBF :: Word8)
+          PM.writeByteArray marr (ix + 2) (0xBD :: Word8)
+          go (ix + 3)
+        else go (ix + 1)
+    else return ()
+
+codepointFromThreeBytes :: Word8 -> Word8 -> Word8 -> Word
+codepointFromThreeBytes w1 w2 w3 = 
+  unsafeShiftL (word8ToWord w1 .&. 0b00001111) 12 .|. 
+  unsafeShiftL (word8ToWord w2 .&. 0b00111111) 6 .|. 
+  (word8ToWord w3 .&. 0b00111111)
+
+convertTuple :: (# (# #) | (# Word#, Word#, Word# #) #) -> Either () (Word,Word,Word)
+convertTuple (# (# #) | #) = Left ()
+convertTuple (# | w #) = Right (convertWordTuple w)
+
+convertWordTuple :: (# Word#, Word#, Word# #) -> (Word,Word,Word)
+convertWordTuple (# a,b,c #) = ( W# a, W# b, W# c )
+
+encodeUtf8 :: Text -> Bytes
+encodeUtf8 t = Bytes arr off len where
+  !(!arr,!off,!len,!_) = textMatch t
+
diff --git a/src/Packed/Text/Small.hs b/src/Packed/Text/Small.hs
new file mode 100644
--- /dev/null
+++ b/src/Packed/Text/Small.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# OPTIONS_GHC
+ -Weverything
+ -fno-warn-unsafe
+ -fno-warn-implicit-prelude
+ -fno-warn-missing-import-lists
+ -O2
+#-}
+module Packed.Text.Small
+  ( SmallText(..)
+  , empty
+  , reverse
+  , decodeAscii
+  ) where
+
+import Prelude hiding (reverse)
+
+import Packed.Bytes.Small (ByteArray)
+import Data.Bits ((.&.))
+import Data.Semigroup (Semigroup)
+import qualified Packed.Bytes.Small as BA
+import qualified Data.Semigroup as SG
+
+newtype SmallText = SmallText ByteArray 
+
+-- Text is UTF-8 encoded with one caveat. There are several operations
+-- that can be faster if we know in advance that all the codepoints in
+-- a piece of text are in the ascii range. So, we use the first
+-- byte to encode the additional information. If the first byte has
+-- zero as the MSB (representing a code point in the ascii range),
+-- it is assumed that the entire piece of text only uses code points
+-- in the ascii range. If however, the first byte is 0b11111111
+-- (which is not valid a UTF-8 byte anywhere), then this first byte is discarded
+-- and it is assumed that the text contains code points from any range.
+-- The first byte is not allowed to be anything starting with 1.
+-- This bloats all non-English text by one byte.
+
+instance Eq SmallText where
+  SmallText a == SmallText b = a == b
+
+-- This is a boolean but with a more efficient way to
+-- do conjunction
+newtype UnicodeRange = UnicodeRange Word
+
+ascii :: UnicodeRange
+ascii = UnicodeRange 1
+
+nonAscii :: UnicodeRange
+nonAscii = UnicodeRange 0
+
+instance Semigroup UnicodeRange where
+  UnicodeRange a <> UnicodeRange b = UnicodeRange (a .&. b)
+
+instance Monoid UnicodeRange where
+  mempty = ascii
+  mappend = (SG.<>)
+
+unicodeRange :: ByteArray -> UnicodeRange
+unicodeRange arr
+  | BA.length arr > 0 =
+      case BA.unsafeIndex arr 0 of
+        0b11111111 -> nonAscii
+        _ -> ascii
+  | otherwise = ascii
+
+empty :: SmallText
+empty = SmallText BA.empty
+
+reverse :: SmallText -> SmallText
+reverse (SmallText arr) = case unicodeRange arr of
+  UnicodeRange 1 -> SmallText (BA.reverse arr)
+  _ -> error "Text.Array.reverse: write the non-ascii case"
+
+decodeAscii :: ByteArray -> Maybe SmallText
+decodeAscii arr = if BA.isAscii arr
+  then Just (SmallText arr)
+  else Nothing
+
+
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,325 @@
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+
+import Data.Set (Set)
+import Data.Word (Word8)
+import Hedgehog (Property,Gen,property,forAll,(===),failure)
+import Hedgehog.Gen (list,enumBounded,int,frequency,choice,element,integral,word8)
+import Hedgehog.Range (Range,linear)
+import Test.Tasty (defaultMain,testGroup,TestTree)
+import Data.Bits ((.&.))
+import Data.Char (chr)
+import Test.Tasty.HUnit (testCase)
+import Test.Tasty.Hedgehog (testProperty)
+import Data.Bifunctor (bimap)
+import Data.Monoid
+import GHC.Exts (Int#)
+import GHC.Types
+import Packed.Bytes (Bytes)
+import Packed.Bytes.Small (ByteArray)
+import GHC.Int (Int(I#))
+import Data.Bits ((.&.),(.|.),unsafeShiftR)
+
+import qualified Data.Char
+import qualified Test.Tasty.Hedgehog as H
+import qualified Packed.Text as T
+import qualified Packed.Bytes.Small as BA
+import qualified Packed.Bytes.Window as BAW
+import qualified Packed.Bytes as B
+import qualified Data.Set as S
+import qualified GHC.OldList as L
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests"
+  [ testGroup "ByteArray"
+    [ testProperty "findByte" findByteProp
+    , testProperty "zipAnd" zipAndProp
+    ]
+  , testGroup "Bytes"
+    [ testProperty "findByte" sliceFindByteProp
+    ]
+  , testGroup "Text"
+    [ testProperty "pack" textPackProp
+    , testProperty "take" textTakeProp
+    , testProperty "drop" textDropProp
+    , testProperty "breakOnChar" textBreakCharProp
+    , testProperty "toUpper" textToUpperProp
+    , testProperty "decodeAscii" textDecodeAscii
+    , testGroup "decodeUtf8"
+      [ testProperty "isomorphism" textDecodeUtf8Iso
+      , testProperty "surrogates" textDecodeUtf8Surrogates
+        -- TODO: test against malformed inputs to decodeUtf8
+      ]
+    ]
+  ]
+
+isAscii :: Word8 -> Bool
+isAscii w = w < 128
+
+decodeAsciiList :: [Word8] -> Maybe String
+decodeAsciiList = mapM
+  (\w -> if isAscii w then Just (chr (fromIntegral w)) else Nothing)
+
+textDecodeAscii :: Property
+textDecodeAscii = property $ do
+  bytes <- forAll genMostlyAsciiBytes
+  front <- forAll (genOffset (L.length bytes))
+  back <- forAll (genOffset (L.length bytes))
+  let truncatedBytes = listDropEnd back (L.drop front bytes)
+      expected = decodeAsciiList truncatedBytes
+      actual = fmap T.unpack (T.decodeAscii (B.dropEnd back (B.drop front (B.pack bytes))))
+  expected === actual
+
+textDecodeUtf8Iso :: Property
+textDecodeUtf8Iso = property $ do
+  chars <- forAll genString
+  front <- forAll (genOffset (L.length chars))
+  back <- forAll (genOffset (L.length chars))
+  let text = T.dropEnd back (T.drop front (T.pack chars))
+      decoded = T.decodeUtf8 (T.encodeUtf8 text)
+  Just (T.unpack text) === fmap T.unpack decoded
+
+textDecodeUtf8Surrogates :: Property
+textDecodeUtf8Surrogates = property $ do
+  chars <- forAll genStringSurrogates
+  front <- forAll (genOffset (L.length chars))
+  back <- forAll (genOffset (L.length chars))
+  let truncatedChars = listDropEnd back (L.drop front chars)
+      cleanChars = map
+        (\c -> if Data.Char.ord c >= 0xD800 && Data.Char.ord c < 0xE000 then chr 0xFFFD else c)
+        truncatedChars
+      bytes = B.pack (foldMap charToBytesWithSurrogates truncatedChars)
+      text = T.dropEnd back (T.drop front (T.pack chars))
+      decoded = T.decodeUtf8 (T.encodeUtf8 text)
+  Just cleanChars === fmap T.unpack decoded
+  Just (T.unpack text) === fmap T.unpack decoded
+  Just cleanChars === fmap T.unpack (T.decodeUtf8 bytes)
+
+textPackProp :: Property
+textPackProp = property $ do
+  chars <- forAll genString
+  front <- forAll (genOffset (L.length chars))
+  back <- forAll (genOffset (L.length chars))
+  let expected = listDropEnd back (L.drop front chars)
+      actual = T.unpack (T.dropEnd back (T.drop front (T.pack chars)))
+  expected === actual
+
+textTakeProp :: Property
+textTakeProp = property $ do
+  chars <- forAll genString
+  n <- forAll (genChop (L.length chars))
+  let expected = L.take n chars
+      actual = T.unpack (T.take n (T.pack chars))
+  expected === actual
+
+textDropProp :: Property
+textDropProp = property $ do
+  chars <- forAll genString
+  n <- forAll (genChop (L.length chars))
+  let expected = L.drop n chars
+      actual = T.unpack (T.drop n (T.pack chars))
+  expected === actual
+
+
+textBreakCharProp :: Property
+textBreakCharProp = property $ do
+  chars <- forAll genString
+  front <- forAll (genOffset (L.length chars))
+  back <- forAll (genOffset (L.length chars))
+  let truncatedChars = listDropEnd back (L.drop front chars)
+  c <- forAll (pickChar truncatedChars)
+  let expected = L.break (== c) truncatedChars
+      actual = bimap T.unpack T.unpack (T.breakChar c (T.dropEnd back (T.drop front (T.pack chars))))
+  expected === actual
+
+textToUpperProp :: Property
+textToUpperProp = property $ do
+  chars <- forAll genString
+  front <- forAll (genOffset (L.length chars))
+  back <- forAll (genOffset (L.length chars))
+  let expected = L.map Data.Char.toUpper (listDropEnd back (L.drop front chars))
+      actual = T.unpack (T.toUpper (T.dropEnd back (T.drop front (T.pack chars))))
+  expected === actual
+
+listDropEnd :: Int -> [a] -> [a]
+listDropEnd n xs = L.take (L.length xs - n) xs
+
+pickChar :: String -> Gen Char
+pickChar s = if L.null s
+  then genCharUnicode
+  else element s
+
+pickByte :: [Word8] -> Gen Word8
+pickByte s = if L.null s
+  then genByte
+  else element s
+
+genChop :: Int -> Gen Int
+genChop originalLen = integral (linear 0 maxDiscard)
+  where
+  maxDiscard = div (originalLen * 6) 5
+
+genOffset :: Int -> Gen Int
+genOffset originalLen = integral (linear 0 maxDiscard)
+  where
+  maxDiscard = min 19 (div originalLen 3)
+
+-- Generates a string that is either entirely ascii
+-- or that is a healthy mixture of characters with
+-- variable UTF-8 byte lengths.
+genString :: Gen String
+genString = frequency [ (3, genStringAscii), (7, genStringUnicode) ]
+
+genSurrogate :: Gen Char
+genSurrogate = fmap chr (int (linear 0xD800 0xDFFF))
+
+genSurrogates :: Gen String
+genSurrogates = list (linear 0 3) genSurrogate
+
+-- Generates a string that may contain unicode characters
+-- in the range U+D800 to U+DFFF.
+genStringSurrogates :: Gen String
+genStringSurrogates = choice
+  [ apcat [genSurrogates, genStringAscii, genSurrogates]
+  , apcat [genSurrogates, genStringUnicode, genSurrogates]
+  ]
+
+-- Only uses ascii characters
+genStringAscii :: Gen String
+genStringAscii = list (linear 0 128) (fmap chr (int (linear 0x00 0x7F)))
+
+-- Pulls from unicode characters that have all different
+-- UTF-8 byte-lengths. 
+genStringUnicode :: Gen String
+genStringUnicode = list (linear 0 128) genCharUnicode
+
+genCharUnicode :: Gen Char
+genCharUnicode = choice
+  [ fmap chr (int (linear 0x00 0x7F))
+  , fmap chr (int (linear 0x80 0x7FF))
+  , fmap (chr . (\x -> if x >= 0xD800 && x <= 0xDFFF then 0xD799 else x)) (int (linear 0x800 0xFFFF))
+  , fmap chr (int (linear 0x10000 0x10FFFF))
+  ]
+
+genByte :: Gen Word8
+genByte = word8 (linear minBound maxBound)
+
+genMostlyAsciiBytes :: Gen [Word8]
+genMostlyAsciiBytes = choice
+  [ apcat
+    [ list (linear 0 20) (word8 (linear 0x00 0x7F))
+    , fmap pure (word8 (linear 0xF0 0xFF))
+    , list (linear 0 20) (word8 (linear 0x00 0x7F))
+    ]
+  , list (linear 0 45) (word8 (linear 0x00 0x7F))
+  ]
+
+
+
+findByteProp :: Property
+findByteProp = property $ do
+  wordList :: [Word8] <- forAll (list (linear 0 128) enumBounded)
+  let len = L.length wordList
+  mindex <- forAll $ frequency
+    [ (4, fmap Just (int (linear 0 (len - 1))))
+    , (1, pure Nothing)
+    ]
+  w <- case mindex of
+    Just ix -> case safeIndex ix wordList of
+      Just b -> pure b
+      Nothing -> if len == 0 && ix == 0 then pure 0 else failure
+    Nothing -> case findUnusedByte (S.fromList wordList) of
+      Just b -> pure b
+      Nothing -> failure
+  L.elemIndex w wordList === BA.findByte w (BA.pack wordList)
+
+sliceFindByteProp :: Property
+sliceFindByteProp = property $ do
+  byteList <- forAll (list (linear 0 128) genByte)
+  front <- forAll (genOffset (L.length byteList))
+  back <- forAll (genOffset (L.length byteList))
+  let truncatedByteList = listDropEnd back (L.drop front byteList)
+  w <- forAll (pickByte truncatedByteList)
+  let expected = L.elemIndex w truncatedByteList
+      actual = B.findByte w (B.dropEnd back (B.drop front (B.pack byteList)))
+  expected === actual
+
+
+zipAndProp :: Property
+zipAndProp = property $ do
+  xsList :: [Word8] <- forAll (list (linear 0 128) enumBounded)
+  ysList :: [Word8] <- forAll (list (linear 0 128) enumBounded)
+  let xs = BA.pack xsList
+      ys = BA.pack ysList
+  L.zipWith (.&.) xsList ysList === BA.unpack (BA.zipAnd xs ys)
+
+safeIndex :: Int -> [a] -> Maybe a
+safeIndex !_ [] = Nothing
+safeIndex !ix (x : xs) = case compare ix 0 of
+  EQ -> Just x
+  LT -> Nothing
+  GT -> safeIndex (ix - 1) xs
+
+findUnusedByte :: Set Word8 -> Maybe Word8
+findUnusedByte s = S.lookupMin (S.difference allBytes s)
+
+allBytes :: Set Word8
+allBytes = S.fromList (enumFromTo minBound maxBound)
+
+apcat :: (Applicative f, Monoid a) => [f a] -> f a
+apcat = fmap mconcat . sequenceA
+
+-- This is nearly the same this as Packed.Text.pack. However, it does
+-- not replace surrogates with U+FFFD. This is useful for testing
+-- that we handle surrogates correctly when decoding UTF-8 text.
+charToBytesWithSurrogates :: Char -> [Word8]
+charToBytesWithSurrogates c
+  | p < 0x80 = [wordToWord8 p]
+  | p < 0x800 = [wordToWord8 (byteTwoOne p), wordToWord8 (byteTwoTwo p)]
+  | p < 0x10000 = [wordToWord8 (byteThreeOne p), wordToWord8 (byteThreeTwo p), wordToWord8 (byteThreeThree p)]
+  | otherwise = [wordToWord8 (byteFourOne p), wordToWord8 (byteFourTwo p), wordToWord8 (byteFourThree p), wordToWord8 (byteFourFour p)]
+  where
+  p :: Word
+  p = fromIntegral (Data.Char.ord c)
+  
+wordToWord8 :: Word -> Word8
+wordToWord8 = fromIntegral
+
+-- precondition: codepoint is less than 0x800
+byteTwoOne :: Word -> Word
+byteTwoOne w = unsafeShiftR w 6 .|. 0b11000000
+
+byteTwoTwo :: Word -> Word
+byteTwoTwo w = (w .&. 0b00111111) .|. 0b10000000
+
+-- precondition: codepoint is less than 0x1000
+byteThreeOne :: Word -> Word
+byteThreeOne w = unsafeShiftR w 12 .|. 0b11100000
+
+byteThreeTwo :: Word -> Word
+byteThreeTwo w = (0b00111111 .&. unsafeShiftR w 6) .|. 0b10000000
+
+byteThreeThree :: Word -> Word
+byteThreeThree w = (w .&. 0b00111111) .|. 0b10000000
+
+-- precondition: codepoint is less than 0x110000
+byteFourOne :: Word -> Word
+byteFourOne w = unsafeShiftR w 18 .|. 0b11110000
+
+byteFourTwo :: Word -> Word
+byteFourTwo w = (0b00111111 .&. unsafeShiftR w 12) .|. 0b10000000
+
+byteFourThree :: Word -> Word
+byteFourThree w = (0b00111111 .&. unsafeShiftR w 6) .|. 0b10000000
+
+byteFourFour :: Word -> Word
+byteFourFour w = (0b00111111 .&. w) .|. 0b10000000
+