diff --git a/Data/Text.hs b/Data/Text.hs
--- a/Data/Text.hs
+++ b/Data/Text.hs
@@ -3,9 +3,9 @@
 
 -- |
 -- Module      : Data.Text
--- Copyright   : (c) Tom Harper 2008-2009,
---               (c) Bryan O'Sullivan 2009,
---               (c) Duncan Coutts 2009
+-- Copyright   : (c) 2008, 2009 Tom Harper,
+--               (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Duncan Coutts
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -47,6 +47,7 @@
     , init
     , null
     , length
+    , compareLength
 
     -- * Transformations
     , map
@@ -140,6 +141,10 @@
     , isSuffixOf
     , isInfixOf
 
+    -- ** View patterns
+    , prefixed
+    , suffixed
+
     -- * Searching
     , filter
     , find
@@ -163,14 +168,16 @@
     ) where
 
 import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,
-                Eq(..), Ord(..), (++),
+                Eq(..), Ord(..), Ordering(..), (++),
                 Read(..), Show(..),
-                (&&), (||), (+), (-), (.), ($), (>>), (*),
+                (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),
                 div, error, not, return, otherwise)
 #if defined(HAVE_DEEPSEQ)
 import Control.DeepSeq (NFData)
 #endif
+#if defined(ASSERTS)
 import Control.Exception (assert)
+#endif
 import Data.Char (isSpace)
 import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))
 #if __GLASGOW_HASKELL__ >= 612
@@ -179,18 +186,17 @@
 import Data.Data (mkNorepType)
 #endif
 import Control.Monad (foldM)
-import Control.Monad.ST (ST)
 import qualified Data.Text.Array as A
 import qualified Data.List as L
 import Data.Monoid (Monoid(..))
-import Data.Word (Word16)
 import Data.String (IsString(..))
 import qualified Data.Text.Fusion as S
 import qualified Data.Text.Fusion.Common as S
 import Data.Text.Fusion (stream, reverseStream, unstream)
 import Data.Text.Internal (Text(..), empty, text, textP)
 import qualified Prelude as P
-import Data.Text.Unsafe (iter, iter_, reverseIter, unsafeHead, unsafeTail)
+import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
+                         unsafeHead, unsafeTail)
 import Data.Text.UnsafeChar (unsafeChr)
 import qualified Data.Text.Encoding.Utf16 as U16
 import Data.Text.Search (indices)
@@ -292,8 +298,8 @@
       len = len1+len2
       x = do
         arr <- A.unsafeNew len
-        copy arr 0 arr1 off1 len1
-        copy arr len1 arr2 off2 (len1+len2)
+        A.copyI arr 0 arr1 off1 len1
+        A.copyI arr len1 arr2 off2 (len1+len2)
         return arr
 {-# INLINE append #-}
 
@@ -304,14 +310,6 @@
     unstream (S.append (stream t1) (stream t2)) = append t1 t2
  #-}
 
-copy :: forall s. A.MArray s Word16 -> Int -> A.Array Word16 -> Int -> Int
-     -> ST s ()
-copy dest i0 src j0 top = go i0 j0
-  where
-    go i j | i >= top  = return ()
-           | otherwise = do A.unsafeWrite dest i (src `A.unsafeIndex` j)
-                            go (i+1) (j+1)
-
 -- | /O(1)/ Returns the first character of a 'Text', which must be
 -- non-empty.  Subject to fusion.
 head :: Text -> Char
@@ -324,7 +322,7 @@
 uncons t@(Text arr off len)
     | len <= 0  = Nothing
     | otherwise = Just (c, textP arr (off+d) (len-d))
-    where (c,d) = iter t 0
+    where Iter c d = iter t 0
 {-# INLINE [1] uncons #-}
 
 -- | Lifted from Control.Arrow and specialized.
@@ -392,7 +390,11 @@
 -- | /O(1)/ Tests whether a 'Text' is empty or not.  Subject to
 -- fusion.
 null :: Text -> Bool
-null (Text _arr _off len) = assert (len >= 0) $ len <= 0
+null (Text _arr _off len) =
+#if defined(ASSERTS)
+    assert (len >= 0) $
+#endif
+    len <= 0
 {-# INLINE [1] null #-}
 
 {-# RULES
@@ -414,6 +416,51 @@
 length t = S.length (stream t)
 {-# INLINE length #-}
 
+-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
+-- Subject to fusion.
+--
+-- This function gives the same answer as comparing against the result
+-- of 'length', but can short circuit if the count of characters is
+-- greater than the number, and hence be more efficient.
+compareLength :: Text -> Int -> Ordering
+compareLength t n = S.compareLengthI (stream t) n
+{-# INLINE [1] compareLength #-}
+
+{-# RULES
+"TEXT compareN/length -> compareLength" [~1] forall t n.
+    compare (length t) n = compareLength t n
+  #-}
+
+{-# RULES
+"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.
+    (==) (length t) n = compareLength t n == EQ
+  #-}
+
+{-# RULES
+"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.
+    (/=) (length t) n = compareLength t n /= EQ
+  #-}
+
+{-# RULES
+"TEXT <N/length -> compareLength/==LT" [~1] forall t n.
+    (<) (length t) n = compareLength t n == LT
+  #-}
+
+{-# RULES
+"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.
+    (<=) (length t) n = compareLength t n /= GT
+  #-}
+
+{-# RULES
+"TEXT >N/length -> compareLength/==GT" [~1] forall t n.
+    (>) (length t) n = compareLength t n == GT
+  #-}
+
+{-# RULES
+"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.
+    (>=) (length t) n = compareLength t n /= LT
+  #-}
+
 -- -----------------------------------------------------------------------------
 -- * Transformations
 -- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
@@ -461,6 +508,12 @@
 -- case conversion rules.  As a result, these functions may map one
 -- input character to two or three output characters. For examples,
 -- see the documentation of each function.
+--
+-- /Note/: In some languages, case conversion is a locale- and
+-- context-dependent operation. The case conversion functions in this
+-- module are /not/ locale sensitive. Programs that require locale
+-- sensitivity should use appropriate versions of the case mapping
+-- functions from the @text-icu@ package.
 
 -- | /O(n)/ Convert a string to folded case.  This function is mainly
 -- useful for performing caseless (also known as case insensitive)
@@ -597,14 +650,18 @@
 
 -- | /O(n)/ Concatenate a list of 'Text's.
 concat :: [Text] -> Text
-concat ts = Text (A.run go) 0 len
+concat ts = case ts' of
+              [] -> empty
+              [t] -> t
+              _ -> Text (A.run go) 0 len
   where
-    len = L.sum (L.map (\(Text _ _ l) -> l) ts)
+    ts' = L.filter (not . null) ts
+    len = L.sum $ L.map lengthWord16 ts'
     go = do
       arr <- A.unsafeNew len
-      let step i (Text a o l) = let j = i + l in copy arr i a o j >> return j
-      foldM step 0 ts >> return arr
-{-# INLINE concat #-}
+      let step i (Text a o l) =
+            let !j = i + l in A.copyI arr i a o j >> return j
+      foldM step 0 ts' >> return arr
 
 -- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
 -- concatenate the results.
@@ -712,7 +769,7 @@
       arr <- A.unsafeNew len
       let loop !d !i | i >= n    = return arr
                      | otherwise = let m = d + l
-                                   in copy arr d a o m >> loop m (i+1)
+                                   in A.copyI arr d a o m >> loop m (i+1)
       loop 0 0
 {-# INLINE [1] replicate #-}
 
@@ -774,8 +831,8 @@
   #-}
 
 -- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
--- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the
--- length of the 'Text'. Subject to fusion.
+-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
+-- is greater than the length of the 'Text'. Subject to fusion.
 drop :: Int -> Text -> Text
 drop n t@(Text arr off len)
     | n <= 0    = t
@@ -802,7 +859,7 @@
   where loop !i | i >= len    = t
                 | p c         = loop (i+d)
                 | otherwise   = textP arr off i
-            where (c,d)       = iter t i
+            where Iter c d    = iter t i
 {-# INLINE [1] takeWhile #-}
 
 {-# RULES
@@ -819,7 +876,7 @@
   where loop !i !l | l >= len  = empty
                    | p c       = loop (i+d) (l+d)
                    | otherwise = Text arr (off+i) (len-l)
-            where (c,d)        = iter t i
+            where Iter c d     = iter t i
 {-# INLINE [1] dropWhile #-}
 
 {-# RULES
@@ -903,7 +960,7 @@
   where k = loop 0
         loop !i | i >= len || not (p c) = i
                 | otherwise             = loop (i+d)
-            where (c,d)                 = iter t i
+            where Iter c d              = iter t i
 {-# INLINE spanBy #-}
 
 -- | /O(n)/ 'breakBy' is like 'spanBy', but the prefix returned is
@@ -919,7 +976,7 @@
     loop t@(Text arr off len)
         | null t    = []
         | otherwise = text arr off n : loop (text arr (off+n) (len-n))
-        where (c,d) = iter t 0
+        where Iter c d = iter t 0
               n     = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
 
 -- | Returns the /array/ index (in units of 'Word16') at which a
@@ -929,7 +986,7 @@
 findAIndexOrEnd q t@(Text _arr _off len) = go 0
     where go !i | i >= len || q c       = i
                 | otherwise             = go (i+d)
-                where (c,d)             = iter t i
+                where Iter c d          = iter t i
     
 -- | /O(n)/ Group characters in a string by equality.
 group :: Text -> [Text]
@@ -1086,34 +1143,31 @@
 {-# INLINE breakEnd #-}
 
 -- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
--- @haystack@.  The first element of the returned pair is the prefix
--- of @haystack@ prior to any matches of @needle@.  The second is a
--- list of pairs.
+-- @haystack@.  Each element of the returned list consists of a pair:
 --
--- The first element of each pair in the list is a span from the
--- beginning of a match to the beginning of the next match, while the
--- second is a span from the beginning of the match to the end of the
--- input.
+-- * The entire string prior to the /k/th match (i.e. the prefix)
 --
+-- * The /k/th match, followed by the remainder of the string
+--
 -- Examples:
 --
 -- > find "::" ""
--- > ==> ("", [])
--- > find "/" "a/b/c/d"
--- > ==> ("a", [("/b","/b/c/d"), ("/c","/c/d"), ("/d","/d")])
+-- > ==> []
+-- > find "/" "a/b/c/"
+-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
 --
 -- In (unlikely) bad cases, this function's time complexity degrades
 -- towards /O(n*m)/.
-find :: Text -> Text -> (Text, [(Text, Text)])
-find pat src@(Text arr off len)
+--
+-- The @needle@ parameter may not be empty.
+find :: Text                    -- ^ @needle@ to search for
+     -> Text                    -- ^ @haystack@ in which to search
+     -> [(Text, Text)]
+find pat src@(Text arr off slen)
     | null pat  = emptyError "find"
-    | otherwise = case indices pat src of
-                    []     -> (src, [])
-                    (x:xs) -> (chunk 0 x, go x xs)
+    | otherwise = L.map step (indices pat src)
   where
-    go !s (x:xs) = (chunk s (x-s), chunk s (len-s)) : go x xs
-    go  s _      = let c = chunk s (len-s)
-                   in [(c,c)]
+    step       x = (chunk 0 x, chunk x (slen-x))
     chunk !n !l  = textP arr (n+off) l
 {-# INLINE find #-}
 
@@ -1203,7 +1257,7 @@
             then loop (start+1) (start+1)
             else Text arr (start+off) (n-start) : loop (n+d) (n+d)
         | otherwise = loop start (n+d)
-        where (c,d) = iter t n
+        where Iter c d = iter t n
 {-# INLINE words #-}
 
 -- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
@@ -1291,6 +1345,53 @@
 "TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.
     isInfixOf (singleton n) h = S.elem n (S.stream h)
   #-}
+
+-------------------------------------------------------------------------------
+-- * View patterns
+
+-- | /O(n)/ Returns the suffix of the second string if its prefix
+-- matches the first.
+--
+-- Examples:
+--
+-- > prefixed "foo" "foobar" == Just "bar"
+-- > prefixed "foo" "quux"   == Nothing
+--
+-- This is particularly useful with the @ViewPatterns@ extension to
+-- GHC, as follows:
+--
+-- > {-# LANGUAGE ViewPatterns #-}
+-- > import Data.Text as T
+-- >
+-- > fnordLength :: Text -> Int
+-- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf
+-- > fnordLength _                              = -1
+prefixed :: Text -> Text -> Maybe Text
+prefixed p@(Text _arr _off plen) t@(Text arr off len)
+    | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)
+    | otherwise        = Nothing
+
+-- | /O(n)/ Returns the prefix of the second string if its suffix
+-- matches the first.
+--
+-- Examples:
+--
+-- > suffixed "bar" "foobar" == Just "foo"
+-- > suffixed "foo" "quux"   == Nothing
+--
+-- This is particularly useful with the @ViewPatterns@ extension to
+-- GHC, as follows:
+--
+-- > {-# LANGUAGE ViewPatterns #-}
+-- > import Data.Text as T
+-- >
+-- > quuxLength :: Text -> Int
+-- > quuxLength (suffixed "quux" -> Just pre) = T.length pre
+-- > quuxLength _                             = -1
+suffixed :: Text -> Text -> Maybe Text
+suffixed p@(Text _arr _off plen) t@(Text arr off len)
+    | p `isSuffixOf` t = Just $! textP arr off (len-plen)
+    | otherwise        = Nothing
 
 emptyError :: String -> a
 emptyError fun = P.error ("Data.Text." ++ fun ++ ": empty input")
diff --git a/Data/Text/Array.hs b/Data/Text/Array.hs
--- a/Data/Text/Array.hs
+++ b/Data/Text/Array.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,
-             Rank2Types, ScopedTypeVariables, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, RecordWildCards,
+    UnboxedTuples #-}
 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
 -- |
 -- Module      : Data.Text.Array
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -26,286 +26,247 @@
 module Data.Text.Array
     (
     -- * Types
-      IArray(..)
-    , Elt(..)
-    , Array
+      Array
     , MArray
 
     -- * Functions
+    , copyM
+    , copyI
     , empty
-    , new
-    , unsafeNew
-    , unsafeFreeze
+#if defined(ASSERTS)
+    , length
+#endif
     , run
     , run2
     , toList
-    , copy
-    , unsafeCopy
+    , unsafeFreeze
+    , unsafeIndex
+    , unsafeNew
+    , unsafeWrite
     ) where
 
-#if 0
-#define BOUNDS_CHECKING
+#if defined(ASSERTS)
 -- This fugly hack is brought by GHC's apparent reluctance to deal
 -- with MagicHash and UnboxedTuples when inferring types. Eek!
-#define CHECK_BOUNDS(_func_,_len_,_k_) \
+# define CHECK_BOUNDS(_func_,_len_,_k_) \
 if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
 #else
-#define CHECK_BOUNDS(_func_,_len_,_k_)
+# define CHECK_BOUNDS(_func_,_len_,_k_)
 #endif
 
-#if defined(__GLASGOW_HASKELL__)
 #include "MachDeps.h"
 
+#if defined(ASSERTS)
+import Control.Exception (assert)
+#endif
+import Data.Bits ((.&.))
+import Data.Text.UnsafeShift (shiftL, shiftR)
 import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
-                 indexWord16Array#, newByteArray#,
-                 readWord16Array#, unsafeCoerce#,
-                 writeWord16Array#, (*#))
-import GHC.Prim (Int#)
+                 indexWord16Array#, indexWordArray#, newByteArray#,
+                 readWord16Array#, readWordArray#, unsafeCoerce#,
+                 writeWord16Array#, writeWordArray#)
 import GHC.ST (ST(..), runST)
-import GHC.Word (Word16(..))
-
-#elif defined(__HUGS__)
-
-import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
-                       newMutableByteArray, readMutableByteArray,
-                       unsafeFreezeMutableByteArray, writeMutableByteArray)
-import Foreign.Storable (Storable, sizeOf)
-import Hugs.ST (ST(..), runST)
-
-#else
-# error not implemented for this compiler
-#endif
-
-import Control.Exception (assert)
-import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
+import GHC.Word (Word16(..), Word(..))
 import Prelude hiding (length, read)
 
-#include "Typeable.h"
-
 -- | Immutable array type.
-data Array e = Array
-    {-# UNPACK #-} !Int -- length (in units of e, not bytes)
-#if defined(__GLASGOW_HASKELL__)
-    ByteArray#
-#elif defined(__HUGS__)
-    !ByteArray
+data Array = Array {
+      aBA :: ByteArray#
+#if defined(ASSERTS)
+    , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
 #endif
-
-INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
+    }
 
 -- | Mutable array type, for use in the ST monad.
-data MArray s e = MArray
-    {-# UNPACK #-} !Int -- length (in units of e, not bytes)
-#if defined(__GLASGOW_HASKELL__)
-    (MutableByteArray# s)
-#elif defined(__HUGS__)
-    !(MutableByteArray s)
+data MArray s = MArray {
+      maBA :: MutableByteArray# s
+#if defined(ASSERTS)
+    , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
 #endif
-
-INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
+    }
 
+#if defined(ASSERTS)
 -- | Operations supported by all arrays.
 class IArray a where
     -- | Return the length of an array.
     length :: a -> Int
 
-instance IArray (Array e) where
-    length (Array len _ba) = len
+instance IArray Array where
+    length = aLen
     {-# INLINE length #-}
 
-instance (Elt e, Show e) => Show (Array e) where
-    show = show . toList
-
-instance IArray (MArray s e) where
-    length (MArray len _ba) = len
+instance IArray (MArray s) where
+    length = maLen
     {-# INLINE length #-}
-
-check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
-check func ary i f
-    | i >= 0 && i < length ary = f ary i
-    | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
-{-# INLINE check #-}
-
--- | Operations supported by all elements that can be stored in
--- arrays.
-class Elt e where
-    -- | Indicate how many bytes would be used for an array of the
-    -- given size.
-    bytesInArray :: Int -> e -> Int
-    -- | Unchecked read of an immutable array.  May return garbage or
-    -- crash on an out-of-bounds access.
-    unsafeIndex :: Array e -> Int -> e
-    -- | Unchecked read of a mutable array.  May return garbage or
-    -- crash on an out-of-bounds access.
-    unsafeRead :: MArray s e -> Int -> ST s e
-    -- | Unchecked write of a mutable array.  May return garbage or
-    -- crash on an out-of-bounds access.
-    unsafeWrite :: MArray s e -> Int -> e -> ST s ()
-
-    -- | Read an immutable array. An invalid index results in a
-    -- runtime error.
-    index :: Array e -> Int -> e
-    index ary i = check "index" ary i unsafeIndex
-    {-# INLINE index #-}
-
-    -- | Read a mutable array. An invalid index results in a runtime
-    -- error.
-    read :: Array e -> Int -> ST s e
-    read ary i = check "read" ary i read
-    {-# INLINE read #-}
-
-    -- | Write a mutable array. An invalid index results in a runtime
-    -- error.
-    write :: Array e -> Int -> ST s e
-    write ary i = check "write" ary i write
-    {-# INLINE write #-}
-
--- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
-unsafeFreeze :: MArray s e -> ST s (Array e)
-
-#if defined(__GLASGOW_HASKELL__)
-
-wORD16_SCALE :: Int# -> Int#
-wORD16_SCALE n# = scale# *# n# where !(I# scale#) = SIZEOF_WORD16
+#endif
 
 -- | Create an uninitialized mutable array.
-unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
-unsafeNew n = assert (n >= 0) . ST $ \s1# ->
-   case bytesInArray n (undefined :: e) of
-     len@(I# len#) ->
-#if defined(BOUNDS_CHECKING)
+unsafeNew :: forall s. Int -> ST s (MArray s)
+unsafeNew n =
+#if defined(ASSERTS)
+    assert (n >= 0) .
+#endif
+    ST $ \s1# ->
+    case bytesInArray n of
+      len@(I# len#) ->
+#if defined(ASSERTS)
          if len < 0 then error (show ("unsafeNew",len)) else
 #endif
          case newByteArray# len# s1# of
-           (# s2#, marr# #) -> (# s2#, MArray n marr# #)
+           (# s2#, marr# #) -> (# s2#, MArray marr#
+#if defined(ASSERTS)
+                                  n
+#endif
+                                  #)
 {-# INLINE unsafeNew #-}
 
-unsafeFreeze (MArray len mba#) = ST $ \s# ->
-                                 (# s#, Array len (unsafeCoerce# mba#) #)
-{-# INLINE unsafeFreeze #-}
-
--- | Create a mutable array, with its elements initialized with the
--- given value.
-new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
-
-#elif defined(__HUGS__)
-
-unsafeIndexArray :: Storable e => Array e -> Int -> e
-unsafeIndexArray (Array off len arr) i =
-    assert (i >= 0 && i < len) $ readByteArray arr (off + i)
-
-unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
-unsafeReadMArray (MArray _len marr) i =
-    assert (i >= 0 && i < len) $ readMutableByteArray marr
-
-unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
-unsafeWriteMArray (MArray len marr) i =
-    assert (i >= 0 && i < len) $ writeMutableByteArray marr
-
--- | Create an uninitialized mutable array.
-unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
-unsafeNew n = new undefined
-  where new :: (Storable e) => e -> ST s (MArray s e)
-        new unused = do
-          marr <- newMutableByteArray (n * sizeOf unused)
-          return (MArray n marr)
-
-unsafeFreeze (MArray len mba) = do
-  ba <- unsafeFreezeMutableByteArray mba
-  return (Array 0 len ba)
-
--- | Create a mutable array, with its elements initialized with the
--- given value.
-new :: (Storable e) => Int -> e -> ST s (MArray s e)
+-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
+unsafeFreeze :: MArray s -> ST s Array
+unsafeFreeze MArray{..} = ST $ \s# ->
+                          (# s#, Array (unsafeCoerce# maBA)
+#if defined(ASSERTS)
+                             maLen
 #endif
-
-new len initVal = do
-  marr <- unsafeNew len
-  sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
-  return marr
-
-instance Elt Word16 where
-#if defined(__GLASGOW_HASKELL__)
+                             #)
+{-# INLINE unsafeFreeze #-}
 
-    bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
-    {-# INLINE bytesInArray #-}
+-- | Indicate how many bytes would be used for an array of the given
+-- size.
+bytesInArray :: Int -> Int
+bytesInArray n = n `shiftL` 1
+{-# INLINE bytesInArray #-}
 
-    unsafeIndex (Array len ba#) i@(I# i#) =
-      CHECK_BOUNDS("unsafeIndex",len,i)
-        case indexWord16Array# ba# i# of r# -> (W16# r#)
-    {-# INLINE unsafeIndex #-}
+-- | Unchecked read of an immutable array.  May return garbage or
+-- crash on an out-of-bounds access.
+unsafeIndex :: Array -> Int -> Word16
+unsafeIndex Array{..} i@(I# i#) =
+  CHECK_BOUNDS("unsafeIndex",aLen,i)
+    case indexWord16Array# aBA i# of r# -> (W16# r#)
+{-# INLINE unsafeIndex #-}
 
-    unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
-      CHECK_BOUNDS("unsafeRead",len,i)
-      case readWord16Array# mba# i# s# of
-        (# s2#, r# #) -> (# s2#, W16# r# #)
-    {-# INLINE unsafeRead #-}
+-- | Unchecked read of an immutable array.  May return garbage or
+-- crash on an out-of-bounds access.
+unsafeIndexWord :: Array -> Int -> Word
+unsafeIndexWord Array{..} i@(I# i#) =
+  CHECK_BOUNDS("unsafeIndexWord",aLen`div`wordFactor,i)
+    case indexWordArray# aBA i# of r# -> (W# r#)
+{-# INLINE unsafeIndexWord #-}
 
-    unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
-      CHECK_BOUNDS("unsafeWrite",len,i)
-      case writeWord16Array# marr# i# e# s1# of
-        s2# -> (# s2#, () #)
-    {-# INLINE unsafeWrite #-}
+-- | Unchecked read of a mutable array.  May return garbage or
+-- crash on an out-of-bounds access.
+unsafeRead :: MArray s -> Int -> ST s Word16
+unsafeRead MArray{..} i@(I# i#) = ST $ \s# ->
+  CHECK_BOUNDS("unsafeRead",maLen,i)
+  case readWord16Array# maBA i# s# of
+    (# s2#, r# #) -> (# s2#, W16# r# #)
+{-# INLINE unsafeRead #-}
 
-#elif defined(__HUGS__)
+-- | Unchecked write of a mutable array.  May return garbage or crash
+-- on an out-of-bounds access.
+unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
+unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
+  CHECK_BOUNDS("unsafeWrite",maLen,i)
+  case writeWord16Array# maBA i# e# s1# of
+    s2# -> (# s2#, () #)
+{-# INLINE unsafeWrite #-}
 
-    bytesInArray n w = sizeOf w * n
-    unsafeIndex = unsafeIndexArray
-    unsafeRead = unsafeReadMArray
-    unsafeWrite = unsafeWriteMArray
+-- | Unchecked read of a mutable array.  May return garbage or
+-- crash on an out-of-bounds access.
+unsafeReadWord :: MArray s -> Int -> ST s Word
+unsafeReadWord MArray{..} i@(I# i#) = ST $ \s# ->
+  CHECK_BOUNDS("unsafeRead64",maLen`div`wordFactor,i)
+  case readWordArray# maBA i# s# of
+    (# s2#, r# #) -> (# s2#, W# r# #)
+{-# INLINE unsafeReadWord #-}
 
-#endif
+-- | Unchecked write of a mutable array.  May return garbage or crash
+-- on an out-of-bounds access.
+unsafeWriteWord :: MArray s -> Int -> Word -> ST s ()
+unsafeWriteWord MArray{..} i@(I# i#) (W# e#) = ST $ \s1# ->
+  CHECK_BOUNDS("unsafeWriteWord",maLen`div`wordFactor,i)
+  case writeWordArray# maBA i# e# s1# of
+    s2# -> (# s2#, () #)
+{-# INLINE unsafeWriteWord #-}
 
 -- | Convert an immutable array to a list.
-toList :: Elt e => Array e -> [e]
-toList a = loop 0
-    where loop i | i < len   = unsafeIndex a i : loop (i+1)
+toList :: Array -> Int -> Int -> [Word16]
+toList ary off len = loop 0
+    where loop i | i < len   = unsafeIndex ary (off+i) : loop (i+1)
                  | otherwise = []
-          len = length a
 
 -- | An empty immutable array.
-empty :: Elt e => Array e
+empty :: Array
 empty = runST (unsafeNew 0 >>= unsafeFreeze)
 
 -- | Run an action in the ST monad and return an immutable array of
 -- its result.
-run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
+run :: (forall s. ST s (MArray s)) -> Array
 run k = runST (k >>= unsafeFreeze)
 
 -- | Run an action in the ST monad and return an immutable array of
 -- its result paired with whatever else the action returns.
-run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)
+run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
 run2 k = runST (do
                  (marr,b) <- k
                  arr <- unsafeFreeze marr
                  return (arr,b))
 
--- | Copy an array in its entirety. The destination array must be at
--- least as big as the source.
-copy :: Elt e => MArray s e     -- ^ source array
-     -> MArray s e              -- ^ destination array
-     -> ST s ()
-copy src dest
-    | length dest >= length src = copy_loop 0
-    | otherwise                 = fail "Data.Text.Array.copy: array too small"
-    where
-      len = length src
-      copy_loop i
-          | i >= len  = return ()
-          | otherwise = do unsafeRead src i >>= unsafeWrite dest i
-                           copy_loop (i+1)
-{-# INLINE copy #-}
+-- | The amount to divide or multiply by to switch between units of
+-- 'Word16' and units of 'Word'.
+wordFactor :: Int
+wordFactor = SIZEOF_HSWORD `shiftR` 1
 
--- | Unsafely copy the elements of an array.
-unsafeCopy :: Elt e =>
-              MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
-unsafeCopy src sidx dest didx count =
+-- | Indicate whether an offset is word-aligned.
+wordAligned :: Int -> Bool
+wordAligned i = i .&. (wordFactor - 1) == 0
+
+-- | Copy some elements of a mutable array.
+copyM :: MArray s               -- ^ Destination
+      -> Int                    -- ^ Destination offset
+      -> MArray s               -- ^ Source
+      -> Int                    -- ^ Source offset
+      -> Int                    -- ^ Count
+      -> ST s ()
+copyM dest didx src sidx count =
+#if defined(ASSERTS)
     assert (sidx + count <= length src) .
     assert (didx + count <= length dest) $
-    copy_loop sidx didx 0
+#endif
+    if srem == 0 && drem == 0
+    then fast_loop 0
+    else slow_loop 0
     where
-      copy_loop !i !j !c
-          | c >= count  = return ()
-          | otherwise = do unsafeRead src i >>= unsafeWrite dest j
-                           copy_loop (i+1) (j+1) (c+1)
-{-# INLINE unsafeCopy #-}
+      (swidx,srem) = sidx `divMod` wordFactor
+      (dwidx,drem) = didx `divMod` wordFactor
+      nwds         = count `div` wordFactor
+      fast_loop !i
+          | i >= nwds = slow_loop (i * wordFactor)
+          | otherwise = do w <- unsafeReadWord src (swidx+i)
+                           unsafeWriteWord dest (dwidx+i) w
+                           fast_loop (i+1)
+      slow_loop !i
+          | i >= count= return ()
+          | otherwise = do unsafeRead src (sidx+i) >>= unsafeWrite dest (didx+i)
+                           slow_loop (i+1)
+
+-- | Copy some elements of an immutable array.
+copyI :: MArray s               -- ^ Destination
+      -> Int                    -- ^ Destination offset
+      -> Array                  -- ^ Source
+      -> Int                    -- ^ Source offset
+      -> Int                    -- ^ First offset in source /not/ to
+                                -- copy (i.e. /not/ length)
+      -> ST s ()
+copyI dest i0 src j0 top
+    | wordAligned i0 && wordAligned j0 = fast (i0 `div` wordFactor) (j0 `div` wordFactor)
+    | otherwise = slow i0 j0
+  where
+    topwds = top `div` wordFactor
+    fast !i !j
+        | i >= topwds = slow (i * wordFactor) (j * wordFactor)
+        | otherwise   = do unsafeWriteWord dest i (src `unsafeIndexWord` j)
+                           fast (i+1) (j+1)
+    slow !i !j
+        | i >= top  = return ()
+        | otherwise = do unsafeWrite dest i (src `unsafeIndex` j)
+                         slow (i+1) (j+1)
diff --git a/Data/Text/Encoding/Fusion.hs b/Data/Text/Encoding/Fusion.hs
--- a/Data/Text/Encoding/Fusion.hs
+++ b/Data/Text/Encoding/Fusion.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, Rank2Types #-}
+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
 
 -- |
 -- Module      : Data.Text.Encoding.Fusion
@@ -31,7 +31,9 @@
     , module Data.Text.Encoding.Fusion.Common
     ) where
 
+#if defined(ASSERTS)
 import Control.Exception (assert)
+#endif
 import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
 import Data.Text.Fusion (Step(..), Stream(..))
 import Data.Text.Fusion.Size
@@ -73,9 +75,8 @@
           | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
           | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
           | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
-          | otherwise = decodeError "streamUtf8" "UTF-8" onErr mx (i+1)
+          | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)
           where
-            mx = if i >= l then Nothing else Just x1
             x1 = idx i
             x2 = idx (i + 1)
             x3 = idx (i + 2)
@@ -182,7 +183,11 @@
       {-# NOINLINE trimUp #-}
       trimUp fp _ off = return $! PS fp 0 off
       copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
-      copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
+      copy0 !src !srcLen !destLen =
+#if defined(ASSERTS)
+        assert (srcLen <= destLen) $
+#endif
+        do
           dest <- mallocByteString destLen
           withForeignPtr src  $ \src'  ->
               withForeignPtr dest $ \dest' ->
diff --git a/Data/Text/Encoding/Fusion/Common.hs b/Data/Text/Encoding/Fusion/Common.hs
--- a/Data/Text/Encoding/Fusion/Common.hs
+++ b/Data/Text/Encoding/Fusion/Common.hs
@@ -28,9 +28,9 @@
     ) where
 
 import Data.Bits ((.&.))
-import Data.Char (ord)
 import Data.Text.Fusion (Step(..), Stream(..))
 import Data.Text.Fusion.Internal (M(..), S(..))
+import Data.Text.UnsafeChar (ord)
 import Data.Text.UnsafeShift (shiftR)
 import Data.Word (Word8)
 import qualified Data.Text.Encoding.Utf8 as U8
diff --git a/Data/Text/Encoding/Utf16.hs b/Data/Text/Encoding/Utf16.hs
--- a/Data/Text/Encoding/Utf16.hs
+++ b/Data/Text/Encoding/Utf16.hs
@@ -2,9 +2,9 @@
 
 -- |
 -- Module      : Data.Text.Encoding.Utf16
--- Copyright   : (c) Tom Harper 2008-2009,
---               (c) Bryan O'Sullivan 2009,
---               (c) Duncan Coutts 2009
+-- Copyright   : (c) 2008, 2009 Tom Harper,
+--               (c) 2009 Bryan O'Sullivan,
+--               (c) 2009 Duncan Coutts
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -33,7 +33,7 @@
 {-# INLINE chr2 #-}
 
 validate1    :: Word16 -> Bool
-validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF
+validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF
 {-# INLINE validate1 #-}
 
 validate2       ::  Word16 -> Word16 -> Bool
diff --git a/Data/Text/Encoding/Utf32.hs b/Data/Text/Encoding/Utf32.hs
--- a/Data/Text/Encoding/Utf32.hs
+++ b/Data/Text/Encoding/Utf32.hs
@@ -1,8 +1,8 @@
 -- |
--- Module      : Data.Text.Encoding.Utf16
--- Copyright   : (c) Tom Harper 2008-2009,
---               (c) Bryan O'Sullivan 2009,
---               (c) Duncan Coutts 2009
+-- Module      : Data.Text.Encoding.Utf32
+-- Copyright   : (c) 2008, 2009 Tom Harper,
+--               (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Duncan Coutts
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -19,5 +19,5 @@
 import Data.Word (Word32)
 
 validate    :: Word32 -> Bool
-validate x1 = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)
+validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)
 {-# INLINE validate #-}
diff --git a/Data/Text/Encoding/Utf8.hs b/Data/Text/Encoding/Utf8.hs
--- a/Data/Text/Encoding/Utf8.hs
+++ b/Data/Text/Encoding/Utf8.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP, MagicHash #-}
 
 -- |
--- Module      : Data.Text.Encoding.Utf16
--- Copyright   : (c) Tom Harper 2008-2009,
---               (c) Bryan O'Sullivan 2009,
---               (c) Duncan Coutts 2009
+-- Module      : Data.Text.Encoding.Utf8
+-- Copyright   : (c) 2008, 2009 Tom Harper,
+--               (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Duncan Coutts
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -30,9 +30,11 @@
     , validate4
     ) where
 
+#if defined(ASSERTS)
 import Control.Exception (assert)
-import Data.Char (ord)
+#endif
 import Data.Bits ((.&.))
+import Data.Text.UnsafeChar (ord)
 import Data.Text.UnsafeShift (shiftR)
 import GHC.Exts
 import GHC.Word (Word8(..))
@@ -47,14 +49,22 @@
 {-# INLINE between #-}
 
 ord2   :: Char -> (Word8,Word8)
-ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)
+ord2 c =
+#if defined(ASSERTS)
+    assert (n >= 0x80 && n <= 0x07ff)
+#endif
+    (x1,x2)
     where
       n  = ord c
       x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
       x2 = fromIntegral $ (n .&. 0x3F)   + 0x80
 
 ord3   :: Char -> (Word8,Word8,Word8)
-ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)
+ord3 c =
+#if defined(ASSERTS)
+    assert (n >= 0x0800 && n <= 0xffff)
+#endif
+    (x1,x2,x3)
     where
       n  = ord c
       x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
@@ -62,7 +72,11 @@
       x3 = fromIntegral $ (n .&. 0x3F) + 0x80
 
 ord4   :: Char -> (Word8,Word8,Word8,Word8)
-ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)
+ord4 c =
+#if defined(ASSERTS)
+    assert (n >= 0x10000)
+#endif
+    (x1,x2,x3,x4)
     where
       n  = ord c
       x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
@@ -105,7 +119,7 @@
 {-# INLINE chr4 #-}
 
 validate1    :: Word8 -> Bool
-validate1 x1 = between x1 0x00 0x7F
+validate1 x1 = x1 <= 0x7F
 {-# INLINE validate1 #-}
 
 validate2       :: Word8 -> Word8 -> Bool
diff --git a/Data/Text/Foreign.hs b/Data/Text/Foreign.hs
--- a/Data/Text/Foreign.hs
+++ b/Data/Text/Foreign.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP #-}
 -- |
 -- Module      : Data.Text.Foreign
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -23,11 +23,18 @@
     -- * Unsafe conversion code
     , lengthWord16
     , unsafeCopyToPtr
+    -- * Low-level manipulation
+    -- $lowlevel
+    , dropWord16
+    , takeWord16
     ) where
 
+#if defined(ASSERTS)
 import Control.Exception (assert)
+#endif
 import Control.Monad.ST (unsafeIOToST)
 import Data.Text.Internal (Text(..), empty)
+import Data.Text.Unsafe (lengthWord16)
 import qualified Data.Text.Array as A
 import Data.Word (Word16)
 import Foreign.Marshal.Alloc (allocaBytes)
@@ -53,7 +60,11 @@
         -> Int                  -- ^ length of source array (in 'Word16' units)
         -> IO Text
 fromPtr _   0   = return empty
-fromPtr ptr len = assert (len > 0) $ return (Text arr 0 len)
+fromPtr ptr len =
+#if defined(ASSERTS)
+    assert (len > 0) $
+#endif
+    return $! Text arr 0 len
   where
     arr = A.run (A.unsafeNew len >>= copy)
     copy marr = loop ptr 0
@@ -63,11 +74,44 @@
           A.unsafeWrite marr i =<< unsafeIOToST (peek p)
           loop (p `plusPtr` 2) (i + 1)
 
--- | /O(1)/ Return the length of a 'Text' in units of 'Word16'.  This
--- is useful for sizing a target array appropriately before using
--- 'unsafeCopyToPtr'.
-lengthWord16 :: Text -> Int
-lengthWord16 (Text _arr _off len) = len
+-- $lowlevel
+--
+-- Foreign functions that use UTF-16 internally may return indices in
+-- units of 'Word16' instead of characters.  These functions may
+-- safely be used with such indices, as they will adjust offsets if
+-- necessary to preserve the validity of a Unicode string.
+
+-- | /O(1)/ Return the prefix of the 'Text' of @n@ 'Word16' units in
+-- length.
+--
+-- If @n@ would cause the 'Text' to end inside a surrogate pair, the
+-- end of the prefix will be advanced by one additional 'Word16' unit
+-- to maintain its validity.
+takeWord16 :: Int -> Text -> Text
+takeWord16 n t@(Text arr off len)
+    | n <= 0               = empty
+    | n >= len || m >= len = t
+    | otherwise            = Text arr off m
+  where
+    m | w < 0xDB00 || w > 0xD8FF = n
+      | otherwise                = n+1
+    w = A.unsafeIndex arr (off+n-1)
+
+-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units
+-- dropped from its beginning.
+--
+-- If @n@ would cause the 'Text' to begin inside a surrogate pair, the
+-- beginning of the suffix will be advanced by one additional 'Word16'
+-- unit to maintain its validity.
+dropWord16 :: Int -> Text -> Text
+dropWord16 n t@(Text arr off len)
+    | n <= 0               = t
+    | n >= len || m >= len = empty
+    | otherwise            = Text arr (off+m) (len-m)
+  where
+    m | w < 0xD800 || w > 0xDBFF = n
+      | otherwise                = n+1
+    w = A.unsafeIndex arr (off+n-1)
 
 -- | /O(n)/ Copy a 'Text' to an array.  The array is assumed to be big
 -- enough to hold the contents of the entire 'Text'.
diff --git a/Data/Text/Fusion.hs b/Data/Text/Fusion.hs
--- a/Data/Text/Fusion.hs
+++ b/Data/Text/Fusion.hs
@@ -3,7 +3,7 @@
 -- |
 -- Module      : Data.Text.Fusion
 -- Copyright   : (c) Tom Harper 2008-2009,
---               (c) Bryan O'Sullivan 2009,
+--               (c) Bryan O'Sullivan 2009-2010,
 --               (c) Duncan Coutts 2009
 --
 -- License     : BSD-style
@@ -47,9 +47,8 @@
                 Num(..), Ord(..), ($), (&&),
                 fromIntegral, otherwise)
 import Data.Bits ((.&.))
-import Data.Char (ord)
 import Data.Text.Internal (Text(..))
-import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
+import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)
 import Data.Text.UnsafeShift (shiftL, shiftR)
 import qualified Data.Text.Array as A
 import qualified Data.Text.Fusion.Common as S
@@ -65,8 +64,7 @@
 stream :: Text -> Stream Char
 stream (Text arr off len) = Stream next off (maxSize len)
     where
-      end = off+len
-      {-# INLINE next #-}
+      !end = off+len
       next !i
           | i >= end                   = Done
           | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)
@@ -94,20 +92,25 @@
 -- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
 unstream :: Stream Char -> Text
 unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)
-    where
-      mlen = upperBound 4 len
-      a = A.run2 (A.unsafeNew mlen >>= (\arr -> loop arr mlen s0 0))
-      loop arr !top !s !i
-          | i + 1 >= top = case next0 s of
-                            Done -> return (arr, i)
-                            _    -> do
-                              let top' = (top `shiftL` 1) + 1
-                              arr' <- A.unsafeNew top'
-                              A.copy arr arr' >> loop arr' top' s i
-          | otherwise = case next0 s of
-               Done       -> return (arr, i)
-               Skip s'    -> loop arr top s' i
-               Yield x s' -> unsafeWrite arr i x >>= loop arr top s'
+  where
+    a = A.run2 (A.unsafeNew mlen >>= \arr -> outer arr mlen s0 0)
+      where mlen = upperBound 4 len
+    outer arr top = loop
+      where
+        loop !s !i =
+            case next0 s of
+              Done          -> return (arr, i)
+              Skip s'       -> loop s' i
+              Yield x s'
+                | j >= top  -> {-# SCC "unstream/resize" #-} do
+                               let top' = (top + 1) `shiftL` 1
+                               arr' <- A.unsafeNew top'
+                               A.copyM arr' 0 arr 0 top
+                               outer arr' top' s i
+                | otherwise -> do d <- unsafeWrite arr i x
+                                  loop s' (i+d)
+                where j | ord x < 0x10000 = i
+                        | otherwise       = i + 1
 {-# INLINE [0] unstream #-}
 {-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
 
@@ -132,10 +135,10 @@
           Done -> return (marr, (j, len-j))
               where j = i + 1
           Skip s1    -> loop s1 i len marr
-          Yield x s1 | i < least -> do
-                       let newLen = len * 2
+          Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do
+                       let newLen = len `shiftL` 1
                        marr' <- A.unsafeNew newLen
-                       A.unsafeCopy marr 0 marr' (newLen-len) len
+                       A.copyM marr' (newLen-len) marr 0 len
                        write s1 (len+i) newLen marr'
                      | otherwise -> write s1 i len marr
             where n = ord x
diff --git a/Data/Text/Fusion/Common.hs b/Data/Text/Fusion/Common.hs
--- a/Data/Text/Fusion/Common.hs
+++ b/Data/Text/Fusion/Common.hs
@@ -29,6 +29,7 @@
     , init
     , null
     , lengthI
+    , compareLengthI
     , isSingleton
 
     -- * Transformations
@@ -99,8 +100,8 @@
     ) where
 
 import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
-                Ord(..), String, (.), ($), (+), (-), (*), (++), (&&),
-                fromIntegral, otherwise)
+                Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
+                (&&), fromIntegral, otherwise)
 import qualified Data.List as L
 import qualified Prelude as P
 import Data.Int (Int64)
@@ -158,8 +159,8 @@
     next N = Done
 {-# INLINE [0] snoc #-}
 
-data E l r = L {-# UNPACK #-} !l
-           | R {-# UNPACK #-} !r
+data E l r = L !l
+           | R !r
 
 -- | /O(n)/ Appends one Stream to the other.
 append :: Stream Char -> Stream Char -> Stream Char
@@ -266,6 +267,25 @@
                            Yield _ s' -> loop_length (z + 1) s'
 {-# INLINE[0] lengthI #-}
 
+-- | /O(n)/ Compares the count of characters in a string to a number.
+-- Subject to fusion.
+--
+-- This function gives the same answer as comparing against the result
+-- of 'lengthI', but can short circuit if the count of characters is
+-- greater than the number, and hence be more efficient.
+compareLengthI :: Integral a => Stream Char -> a -> Ordering
+compareLengthI (Stream next s0 len) n = 
+    case exactly len of
+      Nothing -> loop_cmp 0 s0
+      Just i  -> compare (fromIntegral i) n
+    where
+      loop_cmp !z s  = case next s of
+                         Done       -> compare z n
+                         Skip    s' -> loop_cmp z s'
+                         Yield _ s' | z > n     -> GT
+                                    | otherwise -> loop_cmp (z + 1) s'
+{-# INLINE[0] compareLengthI #-}
+
 -- | /O(n)/ Indicate whether a string contains exactly one element.
 isSingleton :: Stream Char -> Bool
 isSingleton (Stream next s0 _len) = loop 0 s0
@@ -662,8 +682,8 @@
 {-# INLINE [0] take #-}
 
 -- | /O(n)/ drop n, applied to a stream, returns the suffix of the
--- stream of length @n@, or the empty stream if @n@ is greater than the
--- length of the stream.
+-- stream after the first @n@ characters, or the empty stream if @n@
+-- is greater than the length of the stream.
 drop :: Integral a => a -> Stream Char -> Stream Char
 drop n0 (Stream next0 s0 len) =
     Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))
diff --git a/Data/Text/Fusion/Internal.hs b/Data/Text/Fusion/Internal.hs
--- a/Data/Text/Fusion/Internal.hs
+++ b/Data/Text/Fusion/Internal.hs
@@ -34,16 +34,15 @@
 
 -- | Specialised, strict Maybe-like type.
 data M a = N
-         | J {-# UNPACK #-} !a
+         | J !a
 
 type M8 = M Word8
 
 -- Restreaming state.
-data S s = S {-# UNPACK #-} !s
-    {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
+data S s = S !s {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
 
 infixl 2 :*:
-data PairS a b = {-# UNPACK #-} !a :*: {-# UNPACK #-} !b
+data PairS a b = !a :*: !b
                  deriving (Eq, Ord, Show)
 
 -- | Allow a function over a stream to switch between two states.
diff --git a/Data/Text/Fusion/Size.hs b/Data/Text/Fusion/Size.hs
--- a/Data/Text/Fusion/Size.hs
+++ b/Data/Text/Fusion/Size.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-missing-methods #-}
 -- |
 -- Module      : Data.Text.Fusion.Internal
@@ -15,6 +16,7 @@
 module Data.Text.Fusion.Size
     (
       Size
+    , exactly
     , exactSize
     , maxSize
     , unknownSize
@@ -26,19 +28,34 @@
     , isEmpty
     ) where
 
+#if defined(ASSERTS)
 import Control.Exception (assert)
+#endif
 
 data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
           | Max   {-# UNPACK #-} !Int -- ^ Upper bound on size.
           | Unknown                   -- ^ Unknown size.
             deriving (Eq, Show)
 
+exactly :: Size -> Maybe Int
+exactly (Exact n) = Just n
+exactly _         = Nothing
+{-# INLINE exactly #-}
+
 exactSize :: Int -> Size
-exactSize n = assert (n >= 0) Exact n
+exactSize n =
+#if defined(ASSERTS)
+    assert (n >= 0)
+#endif
+    Exact n
 {-# INLINE exactSize #-}
 
 maxSize :: Int -> Size
-maxSize n = assert (n >= 0) Max n
+maxSize n =
+#if defined(ASSERTS)
+    assert (n >= 0)
+#endif
+    Max n
 {-# INLINE maxSize #-}
 
 unknownSize :: Size
diff --git a/Data/Text/IO.hs b/Data/Text/IO.hs
--- a/Data/Text/IO.hs
+++ b/Data/Text/IO.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
+{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}
 -- |
 -- Module      : Data.Text.IO
--- Copyright   : (c) Bryan O'Sullivan 2009,
---               (c) Simon Marlow 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Simon Marlow
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 -- Stability   : experimental
@@ -32,15 +32,16 @@
     ) where
 
 import Data.Text (Text)
-import Prelude hiding (appendFile, getContents, getLine, interact, putStr,
-                       putStrLn, readFile, writeFile)
+import Prelude hiding (appendFile, catch, getContents, getLine, interact,
+                       putStr, putStrLn, readFile, writeFile)
 import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
                   withFile)
 #if __GLASGOW_HASKELL__ <= 610
 import qualified Data.ByteString.Char8 as B
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 #else
-import Control.Exception (throw)
+import Control.Exception (catch, throw)
+import Control.Monad (liftM2, when)
 import Data.IORef (readIORef, writeIORef)
 import qualified Data.Text as T
 import Data.Text.Fusion (stream)
@@ -49,11 +50,13 @@
 import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
                       RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
                       writeCharBuf)
+import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))
 import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,
                                 wantWritableHandle)
 import GHC.IO.Handle.Text (commitBuffer')
 import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
-                            Newline(..))
+                            HandleType(..), Newline(..))
+import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
 import System.IO.Error (isEOFError)
 #endif
 
@@ -87,25 +90,46 @@
 #if __GLASGOW_HASKELL__ <= 610
 hGetContents = fmap decodeUtf8 . B.hGetContents
 #else
-hGetContents h = wantReadableHandle "hGetContents" h $ \hh -> do
-                   (hh',ts) <- readAll hh
-                   return (hh',T.concat ts)
+hGetContents h = do
+  chooseGoodBuffering h
+  wantReadableHandle "hGetContents" h readAll
  where
   readAll hh@Handle__{..} = do
-    buf <- readIORef haCharBuffer
-    let readChunks = do
-          t <- readChunk hh buf
-          (hh',ts) <- readAll hh
-          return (hh', t:ts)
-    readChunks `catch` \e -> do
-      (hh', _) <- hClose_help hh
-      if isEOFError e
-        then return $ if isEmptyBuffer buf
-                      then (hh', [])
-                      else (hh', [T.singleton '\r'])
-        else throw (augmentIOError e "hGetContents" h)
+    let catchError e
+          | isEOFError e = do
+              buf <- readIORef haCharBuffer
+              return $ if isEmptyBuffer buf
+                       then T.empty
+                       else T.singleton '\r'
+          | otherwise = throw (augmentIOError e "hGetContents" h)
+        readChunks = do
+          buf <- readIORef haCharBuffer
+          t <- readChunk hh buf `catch` catchError
+          if T.null t
+            then return [t]
+            else (t:) `fmap` readChunks
+    ts <- readChunks
+    (hh', _) <- hClose_help hh
+    return (hh'{haType=ClosedHandle}, T.concat ts)
 #endif
   
+-- | Use a more efficient buffer size if we're reading in
+-- block-buffered mode with the default buffer size.  When we can
+-- determine the size of the handle we're reading, set the buffer size
+-- to that, so that we can read the entire file in one chunk.
+-- Otherwise, use a buffer size of at least 16KB.
+chooseGoodBuffering :: Handle -> IO ()
+chooseGoodBuffering h = do
+  bufMode <- hGetBuffering h
+  case bufMode of
+    BlockBuffering Nothing -> do
+      d <- catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->
+           if ioe_type e == InappropriateType
+           then return 16384 -- faster than the 2KB default
+           else throw e
+      when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d
+    _ -> return ()
+
 -- | Read a single line from a handle.
 hGetLine :: Handle -> IO Text
 #if __GLASGOW_HASKELL__ <= 610
@@ -128,8 +152,10 @@
   let str = stream t
   case buffer_mode of
      (NoBuffering, _)        -> hPutChars h str
-     (LineBuffering, buf)    -> writeBlocks h True  nl buf str
-     (BlockBuffering _, buf) -> writeBlocks h False nl buf str
+     (LineBuffering, buf)    -> writeLines h nl buf str
+     (BlockBuffering _, buf)
+         | nl == CRLF        -> writeBlocksCRLF h buf str
+         | otherwise         -> writeBlocksRaw h buf str
 
 hPutChars :: Handle -> Stream Char -> IO ()
 hPutChars h (Stream next0 s0 _len) = loop s0
@@ -139,12 +165,18 @@
                 Skip s'    -> loop s'
                 Yield x s' -> hPutChar h x >> loop s'
 
--- This function is largely lifted from GHC.IO.Handle.Text, but
--- adapted to a coinductive stream of data instead of an inductive
+-- The following functions are largely lifted from GHC.IO.Handle.Text,
+-- but adapted to a coinductive stream of data instead of an inductive
 -- list.
-writeBlocks :: Handle -> Bool -> Newline -> Buffer CharBufElem -> Stream Char
-            -> IO ()
-writeBlocks h lineBuffered nl buf0 (Stream next0 s0 _len) = outer s0 buf0
+--
+-- We have several variations of more or less the same code for
+-- performance reasons.  Splitting the original buffered write
+-- function into line- and block-oriented versions gave us a 2.1x
+-- performance improvement.  Lifting out the raw/cooked newline
+-- handling gave a few more percent on top.
+
+writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
+writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
  where
   outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
    where
@@ -159,12 +191,40 @@
                          then do n1 <- writeCharBuf raw n '\r'
                                  writeCharBuf raw n1 '\n'
                          else writeCharBuf raw n x
-                   if lineBuffered
-                     then commit n' True{-needs flush-} False >>= outer s'
-                     else inner s' n'
+                   commit n' True{-needs flush-} False >>= outer s'
           | otherwise    -> writeCharBuf raw n x >>= inner s'
     commit = commitBuffer h raw len
 
+writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
+writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
+ where
+  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
+   where
+    inner !s !n =
+      case next0 s of
+        Done -> commit n False{-no flush-} True{-release-} >> return ()
+        Skip s' -> inner s' n
+        Yield x s'
+          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
+          | x == '\n'    -> do n1 <- writeCharBuf raw n '\r'
+                               writeCharBuf raw n1 '\n' >>= inner s'
+          | otherwise    -> writeCharBuf raw n x >>= inner s'
+    commit = commitBuffer h raw len
+
+writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
+writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
+ where
+  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
+   where
+    inner !s !n =
+      case next0 s of
+        Done -> commit n False{-no flush-} True{-release-} >> return ()
+        Skip s' -> inner s' n
+        Yield x s'
+          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
+          | otherwise    -> writeCharBuf raw n x >>= inner s'
+    commit = commitBuffer h raw len
+
 -- This function is completely lifted from GHC.IO.Handle.Text.
 getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
 getSpareBuffer Handle__{haCharBuffer=ref, 
@@ -191,7 +251,7 @@
 commitBuffer hdl !raw !sz !count flush release = 
   wantWritableHandle "commitAndReleaseBuffer" hdl $
      commitBuffer' raw sz count flush release
-{-# NOINLINE commitBuffer #-}
+{-# INLINE commitBuffer #-}
 #endif
 
 -- | Write a string to a handle, followed by a newline.
diff --git a/Data/Text/IO/Internal.hs b/Data/Text/IO/Internal.hs
--- a/Data/Text/IO/Internal.hs
+++ b/Data/Text/IO/Internal.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
 -- |
 -- Module      : Data.Text.IO.Internal
--- Copyright   : (c) Bryan O'Sullivan 2009,
---               (c) Simon Marlow 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Simon Marlow
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 -- Stability   : experimental
@@ -72,8 +72,8 @@
               let pre | isEmptyBuffer buf1 = T.empty
                       | otherwise          = T.singleton '\r'
               writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
-              let str = reverse $ pre:t:ts
-              if all T.null str
+              let str = reverse . filter (not . T.null) $ pre:t:ts
+              if null str
                 then ioe_EOF
                 else return str
          Just new_buf -> hGetLineLoop hh (t:ts) new_buf
@@ -105,7 +105,7 @@
  | otherwise     = withRawBuffer buf $ go
  where
   go pbuf = do
-    let t = unstream (Stream next r (maxSize (w-r)))
+    let !t = unstream (Stream next r (maxSize (w-r)))
         w' = w - 1
     return $ if ix w' == '\r'
              then (t,w')
@@ -127,7 +127,7 @@
 getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
   case bufferElems buf of
     -- buffer empty: read some more
-    0 -> readTextDevice handle_ buf
+    0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf
 
     -- if the buffer has a single '\r' in it and we're doing newline
     -- translation: read some more
@@ -145,7 +145,7 @@
                  return buf
 
     -- buffer has some chars in it already: just return it
-    _otherwise -> return buf
+    _otherwise -> {-# SCC "otherwise" #-} return buf
 
 -- | Read a single chunk of strict text from a buffer. Used by both
 -- the strict and lazy implementations of hGetContents.
diff --git a/Data/Text/Internal.hs b/Data/Text/Internal.hs
--- a/Data/Text/Internal.hs
+++ b/Data/Text/Internal.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 -- |
 -- Module      : Data.Text.Internal
--- Copyright   : (c) Tom Harper 2008-2009,
---               (c) Bryan O'Sullivan 2009,
---               (c) Duncan Coutts 2009
+-- Copyright   : (c) 2008, 2009 Tom Harper,
+--               (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Duncan Coutts
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -28,28 +28,31 @@
     , showText
     ) where
 
+#if defined(ASSERTS)
 import Control.Exception (assert)
+#endif
 import qualified Data.Text.Array as A
 import Data.Typeable (Typeable)
-import Data.Word (Word16)
 
 -- | A space efficient, packed, unboxed Unicode text type.
 data Text = Text
-    {-# UNPACK #-} !(A.Array Word16) -- payload
+    {-# UNPACK #-} !A.Array          -- payload
     {-# UNPACK #-} !Int              -- offset
     {-# UNPACK #-} !Int              -- length
     deriving (Typeable)
 
 -- | Smart constructor.
-text :: A.Array Word16 -> Int -> Int -> Text
+text :: A.Array -> Int -> Int -> Text
 text arr off len =
-    assert (len >= 0) .
-    assert (off >= 0) .
-    assert (alen == 0 || len == 0 || off < alen) .
-    assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
-    Text arr off len
-  where c    = A.unsafeIndex arr off
-        alen = A.length arr
+#if defined(ASSERTS)
+  let c    = A.unsafeIndex arr off
+      alen = A.length arr
+  in assert (len >= 0) .
+     assert (off >= 0) .
+     assert (alen == 0 || len == 0 || off < alen) .
+     assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
+#endif
+     Text arr off len
 {-# INLINE text #-}
 
 -- | /O(1)/ The empty 'Text'.
@@ -59,7 +62,7 @@
 
 -- | Construct a 'Text' without invisibly pinning its byte array in
 -- memory if its length has dwindled to zero.
-textP :: A.Array Word16 -> Int -> Int -> Text
+textP :: A.Array -> Int -> Int -> Text
 textP arr off len | len == 0  = empty
                   | otherwise = text arr off len
 {-# INLINE textP #-}
@@ -67,5 +70,5 @@
 -- | A useful 'show'-like function for debugging purposes.
 showText :: Text -> String
 showText (Text arr off len) =
-    "Text " ++ (show . take (off+len) . A.toList) arr ++ ' ' :
+    "Text " ++ show (A.toList arr off len) ++ ' ' :
             show off ++ ' ' : show len
diff --git a/Data/Text/Lazy.hs b/Data/Text/Lazy.hs
--- a/Data/Text/Lazy.hs
+++ b/Data/Text/Lazy.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE BangPatterns, CPP #-}
 -- |
 -- Module      : Data.Text.Lazy
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -39,6 +39,10 @@
     , empty
     , fromChunks
     , toChunks
+    , toStrict
+    , fromStrict
+    , foldrChunks
+    , foldlChunks
 
     -- * Basic interface
     , cons
@@ -51,6 +55,7 @@
     , init
     , null
     , length
+    , compareLength
 
     -- * Transformations
     , map
@@ -144,6 +149,10 @@
     , isSuffixOf
     , isInfixOf
 
+    -- ** View patterns
+    , prefixed
+    , suffixed
+
     -- * Searching
     , filter
     , find
@@ -165,7 +174,7 @@
     ) where
 
 import Prelude (Char, Bool(..), Maybe(..), String,
-                Eq(..), Ord(..), Read(..), Show(..),
+                Eq(..), Ord(..), Ordering, Read(..), Show(..),
                 (&&), (+), (-), (.), ($), (++),
                 div, error, flip, fromIntegral, not, otherwise)
 import qualified Prelude as P
@@ -245,6 +254,8 @@
 unpack t = S.unstreamList (stream t)
 {-# INLINE [1] unpack #-}
 
+-- | /O(1)/ Convert a character into a Text.
+-- Subject to fusion.
 singleton :: Char -> Text
 singleton c = Chunk (T.singleton c) Empty
 {-# INLINE [1] singleton #-}
@@ -264,6 +275,22 @@
 toChunks :: Text -> [T.Text]
 toChunks cs = foldrChunks (:) [] cs
 
+-- | /O(n)/ Convert a lazy 'Text' into a strict 'T.Text'.
+toStrict :: Text -> T.Text
+toStrict t = T.concat (toChunks t)
+{-# INLINE [1] toStrict #-}
+
+-- | /O(c)/ Convert a strict 'T.Text' into a lazy 'Text'.
+fromStrict :: T.Text -> Text
+fromStrict t = chunk t Empty
+{-# INLINE [1] fromStrict #-}
+
+-- -----------------------------------------------------------------------------
+-- * Basic functions
+
+-- | /O(n)/ Adds a character to the front of a 'Text'.  This function
+-- is more costly than its 'List' counterpart because it requires
+-- copying a new array.  Subject to fusion.
 cons :: Char -> Text -> Text
 cons c t = Chunk (T.singleton c) t
 {-# INLINE [1] cons #-}
@@ -275,6 +302,8 @@
     unstream (S.cons c (stream t)) = cons c t
  #-}
 
+-- | /O(n)/ Adds a character to the end of a 'Text'.  This copies the
+-- entire array in the process, unless fused.  Subject to fusion.
 snoc :: Text -> Char -> Text
 snoc t c = foldrChunks Chunk (singleton c) t
 {-# INLINE [1] snoc #-}
@@ -380,6 +409,8 @@
     S.last (stream t) = last t
   #-}
 
+-- | /O(n)/ Returns the number of characters in a 'Text'.
+-- Subject to fusion.
 length :: Text -> Int64
 length = foldlChunks go 0
     where go l t = l + fromIntegral (T.length t)
@@ -392,6 +423,20 @@
     S.length (stream t) = length t
  #-}
 
+-- | /O(n)/ Compare the count of characters in a 'Text' to a number.
+-- Subject to fusion.
+--
+-- This function gives the same answer as comparing against the result
+-- of 'length', but can short circuit if the count of characters is
+-- greater than the number, and hence be more efficient.
+compareLength :: Text -> Int64 -> Ordering
+compareLength t n = S.compareLengthI (stream t) n
+{-# INLINE [1] compareLength #-}
+
+-- We don't apply those otherwise appealing length-to-compareLength
+-- rewrite rules here, because they can change the strictness
+-- properties of code.
+
 -- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
 -- each element of @t@.  Subject to array fusion.
 map :: (Char -> Char) -> Text -> Text
@@ -724,8 +769,8 @@
   #-}
 
 -- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
--- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the
--- length of the 'Text'. Subject to fusion.
+-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
+-- is greater than the length of the 'Text'. Subject to fusion.
 drop :: Int64 -> Text -> Text
 drop i t0
     | i <= 0    = t0
@@ -915,38 +960,37 @@
 {-# INLINE breakEnd #-}
 
 -- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
--- @haystack@.  The first element of the returned pair is the prefix
--- of @haystack@ prior to any matches of @needle@.  The second is a
--- list of pairs.
+-- @haystack@.  Each element of the returned list consists of a pair:
 --
--- The first element of each pair in the list is a span from the
--- beginning of a match to the beginning of the next match, while the
--- second is a span from the beginning of the match to the end of the
--- input.
+-- * The entire string prior to the /k/th match (i.e. the prefix)
 --
+-- * The /k/th match, followed by the remainder of the string
+--
 -- Examples:
 --
 -- > find "::" ""
--- > ==> ("", [])
--- > find "/" "a/b/c/d"
--- > ==> ("a", [("/b","/b/c/d"), ("/c","/c/d"), ("/d","/d")])
+-- > ==> []
+-- > find "/" "a/b/c/"
+-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
 --
 -- This function is strict in its first argument, and lazy in its
 -- second.
 --
 -- In (unlikely) bad cases, this function's time complexity degrades
 -- towards /O(n*m)/.
-find :: Text -> Text -> (Text, [(Text, Text)])
+--
+-- The @needle@ parameter may not be empty.
+find :: Text                    -- ^ @needle@ to search for
+     -> Text                    -- ^ @haystack@ in which to search
+     -> [(Text, Text)]
 find pat src
     | null pat  = emptyError "find"
-    | otherwise = case indices pat src of
-                    []     -> (src, [])
-                    (x:xs) -> let h :*: t = splitAtWord x src
-                              in (h, go x xs t)
+    | otherwise = go 0 empty src (indices pat src)
   where
-    go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
-                      in (h, cs) : go x xs t
-    go  _ _      cs = [(cs,cs)]
+    go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s
+                           h'      = append p h
+                       in (h',t) : go x h' t xs
+    go _  _ _ _      = []
 
 -- | /O(n)/ 'breakBy' is like 'spanBy', but the prefix returned is over
 -- elements that fail the predicate @p@.
@@ -1157,6 +1201,55 @@
     isInfixOf (singleton n) h = S.elem n (S.stream h)
   #-}
 
+-------------------------------------------------------------------------------
+-- * View patterns
+
+-- | /O(n)/ Returns the suffix of the second string if its prefix
+-- matches the first.
+--
+-- Examples:
+--
+-- > prefixed "foo" "foobar" == Just "bar"
+-- > prefixed "foo" "quux"   == Nothing
+--
+-- This is particularly useful with the @ViewPatterns@ extension to
+-- GHC, as follows:
+--
+-- > {-# LANGUAGE ViewPatterns #-}
+-- > import Data.Text as T
+-- >
+-- > fnordLength :: Text -> Int
+-- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf
+-- > fnordLength _                              = -1
+prefixed :: Text -> Text -> Maybe Text
+-- Yes, this could be much more efficient.
+prefixed p t
+    | p `isPrefixOf` t = Just (drop (length p) t)
+    | otherwise        = Nothing
+
+-- | /O(n)/ Returns the prefix of the second string if its suffix
+-- matches the first.
+--
+-- Examples:
+--
+-- > suffixed "bar" "foobar" == Just "foo"
+-- > suffixed "foo" "quux"   == Nothing
+--
+-- This is particularly useful with the @ViewPatterns@ extension to
+-- GHC, as follows:
+--
+-- > {-# LANGUAGE ViewPatterns #-}
+-- > import Data.Text as T
+-- >
+-- > quuxLength :: Text -> Int
+-- > quuxLength (suffixed "quux" -> Just pre) = T.length pre
+-- > quuxLength _                             = -1
+suffixed :: Text -> Text -> Maybe Text
+-- Yes, this could be much more efficient.
+suffixed p t
+    | p `isSuffixOf` t = Just (take (length t - length p) t)
+    | otherwise        = Nothing
+
 -- | /O(n)/ 'filter', applied to a predicate and a 'Text',
 -- returns a 'Text' containing those characters that satisfy the
 -- predicate.
@@ -1194,9 +1287,9 @@
 count :: Text -> Text -> Int64
 count pat src
     | null pat        = emptyError "count"
-    | otherwise       = len (indices pat src)
-  where len []     = 0
-        len (_:xs) = 1 + len xs
+    | otherwise       = go 0 (indices pat src)
+  where go !n []     = n
+        go !n (_:xs) = go (n+1) xs
 {-# INLINE [1] count #-}
 
 {-# RULES
diff --git a/Data/Text/Lazy/Builder.hs b/Data/Text/Lazy/Builder.hs
--- a/Data/Text/Lazy/Builder.hs
+++ b/Data/Text/Lazy/Builder.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE BangPatterns, Rank2Types #-}
+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Text.Lazy.Builder
--- Copyright   : Johan Tibell
+-- Copyright   : (c) 2010 Johan Tibell
 -- License     : BSD3-style (see LICENSE)
 -- 
 -- Maintainer  : Johan Tibell <johan.tibell@gmail.com>
@@ -29,18 +29,17 @@
    , flush
    ) where
 
-import Control.Exception (assert)
 import Control.Monad.ST (ST, runST)
 import Data.Bits ((.&.))
-import Data.Char (ord)
 import Data.Monoid (Monoid(..))
 import Data.Text.Internal (Text(..))
-import Data.Text.Lazy.Internal (defaultChunkSize)
+import Data.Text.Lazy.Internal (smallChunkSize)
 import Data.Text.Unsafe (inlineInterleaveST)
+import Data.Text.UnsafeChar (ord, unsafeWrite)
 import Data.Text.UnsafeShift (shiftR)
-import Data.Word (Word16)
 import Prelude hiding (map, putChar)
 
+import qualified Data.String as String
 import qualified Data.Text as S
 import qualified Data.Text.Array as A
 import qualified Data.Text.Lazy as L
@@ -70,6 +69,13 @@
    mappend = append
    {-# INLINE mappend #-}
 
+instance String.IsString Builder where
+    fromString = fromString
+    {-# INLINE fromString #-}
+
+instance Show Builder where
+    show = L.unpack . toLazyText
+
 ------------------------------------------------------------------------
 
 -- | /O(1)./ The empty Builder, satisfying
@@ -113,7 +119,7 @@
 fromText :: S.Text -> Builder
 fromText t@(Text arr off l)
     | S.null t       = empty
-    | l <= copyLimit = writeN l $ \marr o -> unsafeCopy arr off marr o l
+    | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
     | otherwise      = flush `append` mapBuilder (t :)
 {-# INLINE [1] fromText #-}
 
@@ -133,13 +139,15 @@
             | l <= 1 = do
                 arr <- A.unsafeFreeze marr
                 let !t = Text arr o u
-                marr' <- A.unsafeNew defaultChunkSize
-                ts <- inlineInterleaveST (loop marr' 0 0 defaultChunkSize s)
+                marr' <- A.unsafeNew chunkSize
+                ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
                 return $ t : ts
             | otherwise = do
                 n <- unsafeWrite marr (o+u) c
                 loop marr o (u+n) (l-n) cs
     in loop p0 o0 u0 l0 str
+  where
+    chunkSize = smallChunkSize
 {-# INLINE fromString #-}
 
 -- | /O(1)./ A Builder taking a lazy 'L.Text', satisfying
@@ -153,7 +161,7 @@
 ------------------------------------------------------------------------
 
 -- Our internal buffer type
-data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s Word16)
+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
                        {-# UNPACK #-} !Int  -- offset
                        {-# UNPACK #-} !Int  -- used units
                        {-# UNPACK #-} !Int  -- length left
@@ -164,7 +172,7 @@
 -- buffer size.  The construction work takes place if and when the
 -- relevant part of the lazy 'L.Text' is demanded.
 toLazyText :: Builder -> L.Text
-toLazyText = toLazyTextWith defaultChunkSize
+toLazyText = toLazyTextWith smallChunkSize
 
 -- | /O(n)./ Extract a lazy 'L.Text' from a 'Builder', using the given
 -- size for the initial buffer.  The construction work takes place if
@@ -199,6 +207,7 @@
 withSize :: (Int -> Builder) -> Builder
 withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
     runBuilder (f l) k buf
+{-# INLINE withSize #-}
 
 -- | Map the resulting list of texts.
 mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
@@ -225,16 +234,16 @@
 ensureFree !n = withSize $ \ l ->
     if n <= l
     then empty
-    else flush `append'` withBuffer (const (newBuffer (max n defaultChunkSize)))
+    else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
 {-# INLINE [0] ensureFree #-}
 
 -- | Ensure that @n@ many elements are available, and then use @f@ to
 -- write some elements into the memory.
-writeN :: Int -> (forall s. A.MArray s Word16 -> Int -> ST s ()) -> Builder
+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
 writeN n f = ensureFree n `append'` withBuffer (writeNBuffer n f)
 {-# INLINE [0] writeN #-}
 
-writeNBuffer :: Int -> (A.MArray s Word16 -> Int -> ST s ()) -> (Buffer s)
+writeNBuffer :: Int -> (A.MArray s -> Int -> ST s ()) -> (Buffer s)
              -> ST s (Buffer s)
 writeNBuffer n f (Buffer p o u l) = do
     f p (o+u)
@@ -247,39 +256,6 @@
     return $! Buffer arr 0 0 size
 {-# INLINE newBuffer #-}
 
--- | Unsafely copy the elements of an array.
-unsafeCopy :: A.Elt e =>
-              A.Array e -> Int -> A.MArray s e -> Int -> Int -> ST s ()
-unsafeCopy src sidx dest didx count =
-    assert (sidx + count <= A.length src) .
-    assert (didx + count <= A.length dest) $
-    copy_loop sidx didx 0
-  where
-    copy_loop !i !j !c
-        | c >= count  = return ()
-        | otherwise = do A.unsafeWrite dest j (A.unsafeIndex src i)
-                         copy_loop (i+1) (j+1) (c+1)
-{-# INLINE unsafeCopy #-}
-
--- Write a character to the array, starting at the specified offset
--- @i@.  Returns the number of elements written.
-unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int
-unsafeWrite marr i c
-    | n < 0x10000 = do
-        assert (i >= 0) . assert (i < A.length marr) $
-          A.unsafeWrite marr i (fromIntegral n)
-        return 1
-    | otherwise = do
-        assert (i >= 0) . assert (i < A.length marr - 1) $
-          A.unsafeWrite marr i lo
-        A.unsafeWrite marr (i+1) hi
-        return 2
-    where n = ord c
-          m = n - 0x10000
-          lo = fromIntegral $ (m `shiftR` 10) + 0xD800
-          hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
-{-# INLINE unsafeWrite #-}
-
 ------------------------------------------------------------------------
 -- Some nice rules for Builder
 
@@ -292,13 +268,13 @@
 
 {-# RULES
 
-"append/writeN" forall a b (f::forall s. A.MArray s Word16 -> Int -> ST s ())
-                           (g::forall s. A.MArray s Word16 -> Int -> ST s ()) ws.
+"append/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
+                           (g::forall s. A.MArray s -> Int -> ST s ()) ws.
         append (writeN a f) (append (writeN b g) ws) =
             append (writeN (a+b) (\marr o -> f marr o >> g marr (o+a))) ws
 
-"writeN/writeN" forall a b (f::forall s. A.MArray s Word16 -> Int -> ST s ())
-                           (g::forall s. A.MArray s Word16 -> Int -> ST s ()).
+"writeN/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
+                           (g::forall s. A.MArray s -> Int -> ST s ()).
         append (writeN a f) (writeN b g) =
             writeN (a+b) (\marr o -> f marr o >> g marr (o+a))
 
diff --git a/Data/Text/Lazy/Encoding.hs b/Data/Text/Lazy/Encoding.hs
--- a/Data/Text/Lazy/Encoding.hs
+++ b/Data/Text/Lazy/Encoding.hs
@@ -1,6 +1,6 @@
 -- |
 -- Module      : Data.Text.Lazy.Encoding
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -17,39 +17,110 @@
 module Data.Text.Lazy.Encoding
     (
     -- * Decoding ByteStrings to Text
-    --  decodeASCII
-      decodeUtf8
+      decodeASCII
+    , decodeUtf8
+    , decodeUtf16LE
+    , decodeUtf16BE
+    , decodeUtf32LE
+    , decodeUtf32BE
+    -- ** Controllable error handling
     , decodeUtf8With
-    --, decodeUtf16LE
-    --, decodeUtf16BE
-    --, decodeUtf32LE
-    --, decodeUtf32BE
+    , decodeUtf16LEWith
+    , decodeUtf16BEWith
+    , decodeUtf32LEWith
+    , decodeUtf32BEWith
 
     -- * Encoding Text to ByteStrings
     , encodeUtf8
-    --, encodeUtf16LE
-    --, encodeUtf16BE
-    --, encodeUtf32LE
-    --, encodeUtf32BE
+    , encodeUtf16LE
+    , encodeUtf16BE
+    , encodeUtf32LE
+    , encodeUtf32BE
     ) where
 
-import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as B
 import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
-import Data.Text.Lazy (Text)
+import qualified Data.Text.Encoding as TE
 import qualified Data.Text.Lazy.Fusion as F
+import Data.Text.Lazy.Internal (Text(..), chunk, foldrChunks)
 import qualified Data.Text.Lazy.Encoding.Fusion as E
 
+-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
+decodeASCII :: B.ByteString -> Text
+decodeASCII bs = foldr (chunk . TE.decodeASCII) Empty (B.toChunks bs)
+{-# INLINE decodeASCII #-}
+
 -- | Decode a 'ByteString' containing UTF-8 encoded text.
-decodeUtf8With :: OnDecodeError -> ByteString -> Text
+decodeUtf8With :: OnDecodeError -> B.ByteString -> Text
 decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)
 {-# INLINE decodeUtf8With #-}
 
 -- | Decode a 'ByteString' containing UTF-8 encoded text.
-decodeUtf8 :: ByteString -> Text
+decodeUtf8 :: B.ByteString -> Text
 decodeUtf8 = decodeUtf8With strictDecode
 {-# INLINE decodeUtf8 #-}
 
 -- | Encode text using UTF-8 encoding.
-encodeUtf8 :: Text -> ByteString
+encodeUtf8 :: Text -> B.ByteString
 encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))
 {-# INLINE encodeUtf8 #-}
+
+-- | Decode text from little endian UTF-16 encoding.
+decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text
+decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
+{-# INLINE decodeUtf16LEWith #-}
+
+-- | Decode text from little endian UTF-16 encoding.
+decodeUtf16LE :: B.ByteString -> Text
+decodeUtf16LE = decodeUtf16LEWith strictDecode
+{-# INLINE decodeUtf16LE #-}
+
+-- | Decode text from big endian UTF-16 encoding.
+decodeUtf16BEWith :: OnDecodeError -> B.ByteString -> Text
+decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
+{-# INLINE decodeUtf16BEWith #-}
+
+-- | Decode text from big endian UTF-16 encoding.
+decodeUtf16BE :: B.ByteString -> Text
+decodeUtf16BE = decodeUtf16BEWith strictDecode
+{-# INLINE decodeUtf16BE #-}
+
+-- | Encode text using little endian UTF-16 encoding.
+encodeUtf16LE :: Text -> B.ByteString
+encodeUtf16LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16LE) [] txt)
+{-# INLINE encodeUtf16LE #-}
+
+-- | Encode text using big endian UTF-16 encoding.
+encodeUtf16BE :: Text -> B.ByteString
+encodeUtf16BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16BE) [] txt)
+{-# INLINE encodeUtf16BE #-}
+
+-- | Decode text from little endian UTF-32 encoding.
+decodeUtf32LEWith :: OnDecodeError -> B.ByteString -> Text
+decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
+{-# INLINE decodeUtf32LEWith #-}
+
+-- | Decode text from little endian UTF-32 encoding.
+decodeUtf32LE :: B.ByteString -> Text
+decodeUtf32LE = decodeUtf32LEWith strictDecode
+{-# INLINE decodeUtf32LE #-}
+
+-- | Decode text from big endian UTF-32 encoding.
+decodeUtf32BEWith :: OnDecodeError -> B.ByteString -> Text
+decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
+{-# INLINE decodeUtf32BEWith #-}
+
+-- | Decode text from big endian UTF-32 encoding.
+decodeUtf32BE :: B.ByteString -> Text
+decodeUtf32BE = decodeUtf32BEWith strictDecode
+{-# INLINE decodeUtf32BE #-}
+
+-- | Encode text using little endian UTF-32 encoding.
+encodeUtf32LE :: Text -> B.ByteString
+encodeUtf32LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32LE) [] txt)
+{-# INLINE encodeUtf32LE #-}
+
+-- | Encode text using big endian UTF-32 encoding.
+encodeUtf32BE :: Text -> B.ByteString
+encodeUtf32BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32BE) [] txt)
+{-# INLINE encodeUtf32BE #-}
diff --git a/Data/Text/Lazy/Encoding/Fusion.hs b/Data/Text/Lazy/Encoding/Fusion.hs
--- a/Data/Text/Lazy/Encoding/Fusion.hs
+++ b/Data/Text/Lazy/Encoding/Fusion.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE BangPatterns, Rank2Types #-}
+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
 
 -- |
 -- Module      : Data.Text.Lazy.Encoding.Fusion
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com, 
@@ -17,11 +17,11 @@
     (
     -- * Streaming
     --  streamASCII
-     streamUtf8
-    --, streamUtf16LE
-    --, streamUtf16BE
-    --, streamUtf32LE
-    --, streamUtf32BE
+      streamUtf8
+    , streamUtf16LE
+    , streamUtf16BE
+    , streamUtf32LE
+    , streamUtf32BE
 
     -- * Unstreaming
     , unstream
@@ -36,14 +36,19 @@
 import Data.Text.Encoding.Error
 import Data.Text.Fusion (Step(..), Stream(..))
 import Data.Text.Fusion.Size
-import Data.Text.UnsafeChar (unsafeChr8)
-import Data.Word (Word8)
+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
+import Data.Text.UnsafeShift (shiftL)
+import Data.Word (Word8, Word16, Word32)
 import qualified Data.Text.Encoding.Utf8 as U8
+import qualified Data.Text.Encoding.Utf16 as U16
+import qualified Data.Text.Encoding.Utf32 as U32
 import System.IO.Unsafe (unsafePerformIO)
 import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
 import Foreign.Storable (pokeByteOff)
 import Data.ByteString.Internal (mallocByteString, memcpy)
+#if defined(ASSERTS)
 import Control.Exception (assert)
+#endif
 import qualified Data.ByteString.Internal as B
 
 data S = S0
@@ -52,7 +57,7 @@
        | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
        | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
 
-data T = T {-# UNPACK #-} !ByteString {-# UNPACK #-} !S {-# UNPACK #-} !Int
+data T = T !ByteString !S {-# UNPACK #-} !Int
 
 -- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
 -- UTF-8 encoding.
@@ -66,7 +71,7 @@
           Yield (U8.chr2 a b)     (T bs S0 (i+2))
       | i + 2 < len && U8.validate3 a b c =
           Yield (U8.chr3 a b c)   (T bs S0 (i+3))
-      | i + 4 < len && U8.validate4 a b c d =
+      | i + 3 < len && U8.validate4 a b c d =
           Yield (U8.chr4 a b c d) (T bs S0 (i+4))
       where len = B.length ps
             a = B.unsafeIndex ps i
@@ -96,6 +101,174 @@
     consume st             = decodeError "streamUtf8" "UTF-8" onErr Nothing st
 {-# INLINE [0] streamUtf8 #-}
 
+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
+-- endian UTF-16 encoding.
+streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
+streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
+  where
+    next (T bs@(Chunk ps _) S0 i)
+      | i + 1 < len && U16.validate1 x1 =
+          Yield (unsafeChr x1)         (T bs S0 (i+2))
+      | i + 3 < len && U16.validate2 x1 x2 =
+          Yield (U16.chr2 x1 x2)       (T bs S0 (i+4))
+      where len = B.length ps
+            x1   = c (idx  i)      (idx (i + 1))
+            x2   = c (idx (i + 2)) (idx (i + 3))
+            c w1 w2 = w1 + (w2 `shiftL` 8)
+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
+    next st@(T bs s i) =
+      case s of
+        S2 w1 w2       | U16.validate1 (c w1 w2)           ->
+          Yield (unsafeChr (c w1 w2))   es
+        S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
+          Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
+        _ -> consume st
+       where es = T bs S0 i
+             c :: Word8 -> Word8 -> Word16
+             c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)
+    consume (T bs@(Chunk ps rest) s i)
+        | i >= B.length ps = consume (T rest s 0)
+        | otherwise =
+      case s of
+        S0             -> next (T bs (S1 x)          (i+1))
+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))
+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))
+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))
+        S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)
+                           (T bs (S3 w2 w3 w4)       (i+1))
+        where x = B.unsafeIndex ps i
+    consume (T Empty S0 _) = Done
+    consume st             = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st
+{-# INLINE [0] streamUtf16LE #-}
+
+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
+-- endian UTF-16 encoding.
+streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
+streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
+  where
+    next (T bs@(Chunk ps _) S0 i)
+      | i + 1 < len && U16.validate1 x1 =
+          Yield (unsafeChr x1)         (T bs S0 (i+2))
+      | i + 3 < len && U16.validate2 x1 x2 =
+          Yield (U16.chr2 x1 x2)       (T bs S0 (i+4))
+      where len = B.length ps
+            x1   = c (idx  i)      (idx (i + 1))
+            x2   = c (idx (i + 2)) (idx (i + 3))
+            c w1 w2 = (w1 `shiftL` 8) + w2
+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
+    next st@(T bs s i) =
+      case s of
+        S2 w1 w2       | U16.validate1 (c w1 w2)           ->
+          Yield (unsafeChr (c w1 w2))   es
+        S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
+          Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
+        _ -> consume st
+       where es = T bs S0 i
+             c :: Word8 -> Word8 -> Word16
+             c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2
+    consume (T bs@(Chunk ps rest) s i)
+        | i >= B.length ps = consume (T rest s 0)
+        | otherwise =
+      case s of
+        S0             -> next (T bs (S1 x)          (i+1))
+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))
+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))
+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))
+        S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)
+                           (T bs (S3 w2 w3 w4)       (i+1))
+        where x = B.unsafeIndex ps i
+    consume (T Empty S0 _) = Done
+    consume st             = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st
+{-# INLINE [0] streamUtf16BE #-}
+
+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
+-- endian UTF-32 encoding.
+streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
+streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
+  where
+    next (T bs@(Chunk ps _) S0 i)
+      | i + 3 < len && U32.validate x =
+          Yield (unsafeChr32 x)       (T bs S0 (i+4))
+      where len = B.length ps
+            x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
+            x1    = idx i
+            x2    = idx (i+1)
+            x3    = idx (i+2)
+            x4    = idx (i+3)
+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
+    next st@(T bs s i) =
+      case s of
+        S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
+          Yield (unsafeChr32 (c w1 w2 w3 w4)) es
+        _ -> consume st
+       where es = T bs S0 i
+             c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
+             c w1 w2 w3 w4 = shifted
+              where
+               shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
+               x1 = fromIntegral w1
+               x2 = fromIntegral w2
+               x3 = fromIntegral w3
+               x4 = fromIntegral w4
+    consume (T bs@(Chunk ps rest) s i)
+        | i >= B.length ps = consume (T rest s 0)
+        | otherwise =
+      case s of
+        S0             -> next (T bs (S1 x)          (i+1))
+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))
+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))
+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))
+        S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)
+                           (T bs (S3 w2 w3 w4)       (i+1))
+        where x = B.unsafeIndex ps i
+    consume (T Empty S0 _) = Done
+    consume st             = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st
+{-# INLINE [0] streamUtf32BE #-}
+
+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
+-- endian UTF-32 encoding.
+streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
+streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
+  where
+    next (T bs@(Chunk ps _) S0 i)
+      | i + 3 < len && U32.validate x =
+          Yield (unsafeChr32 x)       (T bs S0 (i+4))
+      where len = B.length ps
+            x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
+            x1    = idx i
+            x2    = idx (i+1)
+            x3    = idx (i+2)
+            x4    = idx (i+3)
+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
+    next st@(T bs s i) =
+      case s of
+        S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
+          Yield (unsafeChr32 (c w1 w2 w3 w4)) es
+        _ -> consume st
+       where es = T bs S0 i
+             c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
+             c w1 w2 w3 w4 = shifted
+              where
+               shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
+               x1 = fromIntegral w1
+               x2 = fromIntegral w2
+               x3 = fromIntegral w3
+               x4 = fromIntegral w4
+    consume (T bs@(Chunk ps rest) s i)
+        | i >= B.length ps = consume (T rest s 0)
+        | otherwise =
+      case s of
+        S0             -> next (T bs (S1 x)          (i+1))
+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))
+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))
+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))
+        S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)
+                           (T bs (S3 w2 w3 w4)       (i+1))
+        where x = B.unsafeIndex ps i
+    consume (T Empty S0 _) = Done
+    consume st             = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st
+{-# INLINE [0] streamUtf32LE #-}
+
 -- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
 unstreamChunks :: Int -> Stream Word8 -> ByteString
 unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
@@ -123,7 +296,11 @@
               loop n' (off+1) s fp'
             trimUp fp off = B.PS fp 0 off
             copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
-            copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
+            copy0 !src !srcLen !destLen =
+#if defined(ASSERTS)
+              assert (srcLen <= destLen) $
+#endif
+              do
                 dest <- mallocByteString destLen
                 withForeignPtr src  $ \src'  ->
                     withForeignPtr dest $ \dest' ->
diff --git a/Data/Text/Lazy/Fusion.hs b/Data/Text/Lazy/Fusion.hs
--- a/Data/Text/Lazy/Fusion.hs
+++ b/Data/Text/Lazy/Fusion.hs
@@ -1,6 +1,7 @@
+{-# LANGUAGE BangPatterns #-}
 -- |
 -- Module      : Data.Text.Lazy.Fusion
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -29,7 +30,8 @@
 import qualified Data.Text.Internal as I
 import qualified Data.Text.Array as A
 import Data.Text.UnsafeChar (unsafeWrite)
-import Data.Text.Unsafe (iter)
+import Data.Text.UnsafeShift (shiftL)
+import Data.Text.Unsafe (Iter(..), iter)
 import Data.Int (Int64)
 
 default(Int64)
@@ -42,7 +44,7 @@
     next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)
         | i >= len  = next (ts :*: 0)
         | otherwise = Yield c (txt :*: i+d)
-        where (c,d) = iter t i
+        where Iter c d = iter t i
 {-# INLINE [0] stream #-}
 
 -- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
@@ -58,21 +60,21 @@
                 Yield x s' -> I.Text arr 0 len `chunk` outer s''
                   where (arr,(s'',len)) = A.run2 fill
                         fill = do a <- A.unsafeNew unknownLength
-                                  i <- unsafeWrite a 0 x
-                                  inner a unknownLength s' i
+                                  unsafeWrite a 0 x >>= inner a unknownLength s'
                         unknownLength = 4
-    inner marr len s i
+    inner marr len s !i
         | i + 1 >= chunkSize = return (marr, (s,i))
         | i + 1 >= len       = do
-            let newLen = min (len * 2) chunkSize
+            let newLen = min (len `shiftL` 1) chunkSize
             marr' <- A.unsafeNew newLen
-            A.copy marr marr'
+            A.copyM marr' 0 marr 0 len
             inner marr' newLen s i
         | otherwise =
             case next s of
               Done        -> return (marr,(s,i))
               Skip s'     -> inner marr len s' i
-              Yield x s'  -> unsafeWrite marr i x >>= inner marr len s'
+              Yield x s'  -> do d <- unsafeWrite marr i x
+                                inner marr len s' (i+d)
 {-# INLINE [0] unstreamChunks #-}
 
 -- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
@@ -89,9 +91,9 @@
 {-# RULES "LAZY STREAM stream/unstream fusion" forall s.
     stream (unstream s) = s #-}
 
--- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed
+-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
 -- value. However, the length of the result is limited by the
--- first argument to 'unfoldrN64'. This function is more efficient than
+-- first argument to 'unfoldrN'. This function is more efficient than
 -- 'unfoldr' when the length of the result is known.
 unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char
 unfoldrN n = S.unfoldrNI n
diff --git a/Data/Text/Lazy/IO.hs b/Data/Text/Lazy/IO.hs
--- a/Data/Text/Lazy/IO.hs
+++ b/Data/Text/Lazy/IO.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
 -- |
 -- Module      : Data.Text.Lazy.IO
--- Copyright   : (c) Bryan O'Sullivan 2009,
---               (c) Simon Marlow 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Simon Marlow
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 -- Stability   : experimental
@@ -44,6 +44,7 @@
 import qualified Data.ByteString.Lazy.Char8 as L8
 #else
 import Control.Exception (throw)
+import Control.Monad (when)
 import Data.IORef (readIORef)
 import Data.Text.IO.Internal (hGetLineWith, readChunk)
 import Data.Text.Lazy.Internal (chunk, empty)
@@ -52,6 +53,7 @@
 import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
                                 wantReadableHandle, withHandle)
 import GHC.IO.Handle.Types (Handle__(..), HandleType(..))
+import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
 import System.IO.Error (isEOFError)
 import System.IO.Unsafe (unsafeInterleaveIO)
 #endif
@@ -76,10 +78,19 @@
 #if __GLASGOW_HASKELL__ <= 610
 hGetContents = fmap decodeUtf8 . L8.hGetContents
 #else
-hGetContents h =
-    wantReadableHandle "hGetContents" h $ \hh -> do
-      ts <- lazyRead h
-      return (hh{haType=SemiClosedHandle}, ts)
+hGetContents h = do
+  chooseGoodBuffering h
+  wantReadableHandle "hGetContents" h $ \hh -> do
+    ts <- lazyRead h
+    return (hh{haType=SemiClosedHandle}, ts)
+
+-- | Use a more efficient buffer size if we're reading in
+-- block-buffered mode with the default buffer size.
+chooseGoodBuffering :: Handle -> IO ()
+chooseGoodBuffering h = do
+  bufMode <- hGetBuffering h
+  when (bufMode == BlockBuffering Nothing) $
+    hSetBuffering h (BlockBuffering (Just 16384))
 
 lazyRead :: Handle -> IO Text
 lazyRead h = unsafeInterleaveIO $
diff --git a/Data/Text/Lazy/Internal.hs b/Data/Text/Lazy/Internal.hs
--- a/Data/Text/Lazy/Internal.hs
+++ b/Data/Text/Lazy/Internal.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
 -- |
 -- Module      : Data.Text.Lazy.Internal
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -21,9 +21,12 @@
     , foldrChunks
     , foldlChunks
     -- * Data type invariant and abstraction functions
-    , invariant
-    , checkInvariant
+
+    -- $invariant
+    , strictInvariant
+    , lazyInvariant
     , showStructure
+
     -- * Chunk allocation sizes
     , defaultChunkSize
     , smallChunkSize
@@ -32,35 +35,43 @@
 
 import qualified Data.Text.Internal as T
 import Data.Text ()
+import Data.Text.UnsafeShift
 import Data.Typeable (Typeable)
-import Data.Word (Word16)
 import Foreign.Storable (sizeOf)
 
 data Text = Empty
           | Chunk {-# UNPACK #-} !T.Text Text
             deriving (Typeable)
 
--- | The data type invariant: Every 'Text' is either 'Empty' or
+-- $invariant
+--
+-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or
 -- consists of non-null 'T.Text's.  All functions must preserve this,
 -- and the QC properties must check this.
-invariant :: Text -> Bool
-invariant Empty                       = True
-invariant (Chunk (T.Text _ _ len) cs) = len > 0 && invariant cs
 
+-- | Check the invariant strictly.
+strictInvariant :: Text -> Bool
+strictInvariant Empty = True
+strictInvariant x@(Chunk (T.Text _ _ len) cs)
+    | len > 0   = strictInvariant cs
+    | otherwise = error $ "Data.Text.Lazy: invariant violation: "
+                  ++ showStructure x
+
+-- | Check the invariant lazily.
+lazyInvariant :: Text -> Text
+lazyInvariant Empty = Empty
+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
+    | len > 0   = Chunk c (lazyInvariant cs)
+    | otherwise = error $ "Data.Text.Lazy: invariant violation: "
+                  ++ showStructure x
+
+-- | Display the internal structure of a lazy 'Text'.
 showStructure :: Text -> String
 showStructure Empty           = "Empty"
 showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"
 showStructure (Chunk t ts)    =
     "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"
 
--- | In a form that checks the invariant lazily.
-checkInvariant :: Text -> Text
-checkInvariant Empty = Empty
-checkInvariant (Chunk c@(T.Text _ _ len) cs)
-    | len > 0   = Chunk c (checkInvariant cs)
-    | otherwise = error $ "Data.Text.Lazy: invariant violation: "
-               ++ showStructure (Chunk c cs)
-
 -- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
 chunk :: T.Text -> Text -> Text
 {-# INLINE chunk #-}
@@ -87,17 +98,17 @@
         go !a (Chunk c cs) = go (f a c) cs
 {-# INLINE foldlChunks #-}
 
--- | Currently set to 32k, less the memory management overhead.
+-- | Currently set to 16 KiB, less the memory management overhead.
 defaultChunkSize :: Int
-defaultChunkSize = 32 * k - chunkOverhead
-   where k = 1024 `div` sizeOf (undefined :: Word16)
+defaultChunkSize = 16384 - chunkOverhead
 {-# INLINE defaultChunkSize #-}
 
--- | Currently set to 4k, less the memory management overhead.
+-- | Currently set to 128 bytes, less the memory management overhead.
 smallChunkSize :: Int
-smallChunkSize = 4 * k - chunkOverhead
-   where k = 1024 `div` sizeOf (undefined :: Word16)
+smallChunkSize = 128 - chunkOverhead
+{-# INLINE smallChunkSize #-}
 
 -- | The memory management overhead. Currently this is tuned for GHC only.
 chunkOverhead :: Int
-chunkOverhead = 2 * sizeOf (undefined :: Int)
+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1
+{-# INLINE chunkOverhead #-}
diff --git a/Data/Text/Lazy/Search.hs b/Data/Text/Lazy/Search.hs
--- a/Data/Text/Lazy/Search.hs
+++ b/Data/Text/Lazy/Search.hs
@@ -2,7 +2,7 @@
 
 -- |
 -- Module      : Data.Text.Lazy.Search
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -41,7 +41,7 @@
         -> [Int64]
 indices needle@(Chunk n ns) _haystack@(Chunk k ks)
     | nlen <= 0  = []
-    | nlen == 1  = scanOne (nindex 0) 0 k ks
+    | nlen == 1  = indicesOne (nindex 0) 0 k ks
     | otherwise  = scan 0 0 k ks
   where
     scan !g !i x@(T.Text _ _ l) xs
@@ -81,14 +81,6 @@
                   skp' | c == z    = nlen - fromIntegral g - 2
                        | otherwise = skp
                   xlast = xlen - 1
-    scanOne c i (T.Text oarr ooff olen) os = go 0
-      where
-        go h | h >= olen = case os of
-                             Empty      -> []
-                             Chunk y ys -> scanOne c (i+fromIntegral olen) y ys
-             | on == c = i + fromIntegral h : go (h+1)
-             | otherwise = go (h+1)
-             where on = A.unsafeIndex oarr (ooff+h)
     -- | Check whether an attempt to index into the haystack at the
     -- given offset would fail.
     lackingHay q = go 0
@@ -103,7 +95,7 @@
 -- the possibility that the caller might try to access one element
 -- past the end.
 index :: T.Text -> Text -> Int64 -> Word16
-index (T.Text arr off len) xs i
+index (T.Text arr off len) xs !i
     | j < len   = A.unsafeIndex arr (off+j)
     | otherwise = case xs of
                     Empty
@@ -113,6 +105,19 @@
                         | otherwise -> emptyError "index"
                     Chunk c cs -> index c cs (i-fromIntegral len)
     where j = fromIntegral i
+
+-- | A variant of 'indices' that scans linearly for a single 'Word16'.
+indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
+indicesOne c = chunk
+  where
+    chunk !i (T.Text oarr ooff olen) os = go 0
+      where
+        go h | h >= olen = case os of
+                             Empty      -> []
+                             Chunk y ys -> chunk (i+fromIntegral olen) y ys
+             | on == c = i + fromIntegral h : go (h+1)
+             | otherwise = go (h+1)
+             where on = A.unsafeIndex oarr (ooff+h)
 
 -- | The number of 'Word16' values in a 'Text'.
 wordLength :: Text -> Int64
diff --git a/Data/Text/Search.hs b/Data/Text/Search.hs
--- a/Data/Text/Search.hs
+++ b/Data/Text/Search.hs
@@ -40,7 +40,8 @@
 import Data.Text.UnsafeShift (shiftL)
 
 -- | /O(n+m)/ Find the offsets of all non-overlapping indices of
--- @needle@ within @haystack@.
+-- @needle@ within @haystack@.  The offsets returned represent
+-- locations in the low-level array.
 --
 -- In (unlikely) bad cases, this algorithm's complexity degrades
 -- towards /O(n*m)/.
@@ -57,6 +58,8 @@
     z        = nindex nlast
     nindex k = A.unsafeIndex narr (noff+k)
     hindex k = A.unsafeIndex harr (hoff+k)
+    hindex' k | k == hlen  = 0
+              | otherwise = A.unsafeIndex harr (hoff+k)
     (mask :: Word64) :*: skip  = buildTable 0 0 (nlen-2)
     buildTable !i !msk !skp
         | i >= nlast           = (msk .|. swizzle z) :*: skp
@@ -77,7 +80,7 @@
               delta | nextInPattern = nlen + 1
                     | c == z        = skip + 1
                     | otherwise     = 1
-              nextInPattern         = mask .&. swizzle (hindex (i+nlen)) == 0
+              nextInPattern         = mask .&. swizzle (hindex' (i+nlen)) == 0
     scanOne c = loop 0
         where loop !i | i >= hlen     = []
                       | hindex i == c = i : loop (i+1)
diff --git a/Data/Text/Unsafe.hs b/Data/Text/Unsafe.hs
--- a/Data/Text/Unsafe.hs
+++ b/Data/Text/Unsafe.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 -- |
 -- Module      : Data.Text.Unsafe
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
 --               duncan@haskell.org
@@ -14,14 +14,18 @@
     (
       inlineInterleaveST
     , inlinePerformIO
+    , Iter(..)
     , iter
     , iter_
     , reverseIter
     , unsafeHead
     , unsafeTail
+    , lengthWord16
     ) where
      
+#if defined(ASSERTS)
 import Control.Exception (assert)
+#endif
 import Data.Text.Encoding.Utf16 (chr2)
 import Data.Text.Internal (Text(..))
 import Data.Text.UnsafeChar (unsafeChr)
@@ -40,11 +44,11 @@
 -- omits the check for the empty case, so there is an obligation on
 -- the programmer to provide a proof that the 'Text' is non-empty.
 unsafeHead :: Text -> Char
-unsafeHead (Text arr off len)
+unsafeHead (Text arr off _len)
     | m < 0xD800 || m > 0xDBFF = unsafeChr m
     | otherwise                = chr2 m n
-    where m = assert (len > 0) $ A.unsafeIndex arr off
-          n = assert (len > 1) $ A.unsafeIndex arr (off+1)
+    where m = A.unsafeIndex arr off
+          n = A.unsafeIndex arr (off+1)
 {-# INLINE unsafeHead #-}
 
 -- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'
@@ -52,42 +56,47 @@
 -- the programmer to provide a proof that the 'Text' is non-empty.
 unsafeTail :: Text -> Text
 unsafeTail t@(Text arr off len) =
-    assert (d <= len) $ Text arr (off+d) (len-d)
+#if defined(ASSERTS)
+    assert (d <= len) $
+#endif
+    Text arr (off+d) (len-d)
   where d = iter_ t 0
 {-# INLINE unsafeTail #-}
 
--- | /O(1)/ Iterate one step forwards through a UTF-16 array,
--- returning the current character and the delta to add to give the
--- next offset to iterate at.
-iter :: Text -> Int -> (Char,Int)
-iter (Text arr off len) i
-    | m < 0xD800 || m > 0xDBFF = (unsafeChr m, 1)
-    | otherwise                = (chr2 m n,    2)
-  where m = assert (i < len)     $ A.unsafeIndex arr j
-        n = assert (i + 1 < len) $ A.unsafeIndex arr k
-        j = assert (i >= 0)      $ off + i
-        k =                        j + 1
+data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
+
+-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
+-- array, returning the current character and the delta to add to give
+-- the next offset to iterate at.
+iter :: Text -> Int -> Iter
+iter (Text arr off _len) i
+    | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
+    | otherwise                = Iter (chr2 m n) 2
+  where m = A.unsafeIndex arr j
+        n = A.unsafeIndex arr k
+        j = off + i
+        k = j + 1
 {-# INLINE iter #-}
 
 -- | /O(1)/ Iterate one step through a UTF-16 array, returning the
 -- delta to add to give the next offset to iterate at.
 iter_ :: Text -> Int -> Int
-iter_ (Text arr off len) i | m < 0xD800 || m > 0xDBFF = 1
-                           | otherwise                = 2
-  where m = assert (i >= 0 && i < len) $ A.unsafeIndex arr (off+i)
+iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
+                            | otherwise                = 2
+  where m = A.unsafeIndex arr (off+i)
 {-# INLINE iter_ #-}
 
 -- | /O(1)/ Iterate one step backwards through a UTF-16 array,
 -- returning the current character and the delta to add (i.e. a
 -- negative number) to give the next offset to iterate at.
 reverseIter :: Text -> Int -> (Char,Int)
-reverseIter (Text arr off len) i
+reverseIter (Text arr off _len) i
     | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
     | otherwise                = (chr2 n m,    -2)
-  where m = assert (i < len)    $ A.unsafeIndex arr j
-        n = assert (i - 1 >= 0) $ A.unsafeIndex arr k
-        j = assert (i >= 0)     $ off + i
-        k =                       j - 1
+  where m = A.unsafeIndex arr j
+        n = A.unsafeIndex arr k
+        j = off + i
+        k = j - 1
 {-# INLINE reverseIter #-}
 
 -- | Just like unsafePerformIO, but we inline it. Big performance gains as
@@ -116,3 +125,10 @@
 inlineInterleaveST (ST m) = ST $ \ s ->
     let r = case m s of (# _, res #) -> res in (# s, r #)
 {-# INLINE inlineInterleaveST #-}
+
+-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'.  This
+-- is useful for sizing a target array appropriately before using
+-- 'unsafeCopyToPtr'.
+lengthWord16 :: Text -> Int
+lengthWord16 (Text _arr _off len) = len
+{-# INLINE lengthWord16 #-}
diff --git a/Data/Text/UnsafeChar.hs b/Data/Text/UnsafeChar.hs
--- a/Data/Text/UnsafeChar.hs
+++ b/Data/Text/UnsafeChar.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP, MagicHash #-}
 
 -- |
 -- Module      : Data.Text.UnsafeChar
--- Copyright   : (c) Tom Harper 2008-2009,
---               (c) Bryan O'Sullivan 2009,
---               (c) Duncan Coutts 2009
+-- Copyright   : (c) 2008, 2009 Tom Harper,
+--               (c) 2009, 2010 Bryan O'Sullivan,
+--               (c) 2009 Duncan Coutts
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
@@ -15,22 +15,28 @@
 -- Fast character manipulation functions.
 module Data.Text.UnsafeChar
     (
-      unsafeChr
+      ord
+    , unsafeChr
     , unsafeChr8
     , unsafeChr32
     , unsafeWrite
     -- , unsafeWriteRev
     ) where
 
+#ifdef ASSERTS
 import Control.Exception (assert)
+#endif
 import Control.Monad.ST (ST)
 import Data.Bits ((.&.))
-import Data.Char (ord)
 import Data.Text.UnsafeShift (shiftR)
-import GHC.Exts (Char(..), chr#, word2Int#)
+import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
 import GHC.Word (Word8(..), Word16(..), Word32(..))
 import qualified Data.Text.Array as A
 
+ord :: Char -> Int
+ord (C# c#) = I# (ord# c#)
+{-# INLINE ord #-}
+
 unsafeChr :: Word16 -> Char
 unsafeChr (W16# w#) = C# (chr# (word2Int# w#))
 {-# INLINE unsafeChr #-}
@@ -43,17 +49,23 @@
 unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
 {-# INLINE unsafeChr32 #-}
 
-unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int
+-- | Write a character into the array at the given offset.  Returns
+-- the number of 'Word16's written.
+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int
 unsafeWrite marr i c
     | n < 0x10000 = do
-        assert (i >= 0) . assert (i < A.length marr) $
-          A.unsafeWrite marr i (fromIntegral n)
-        return (i+1)
+#if defined(ASSERTS)
+        assert (i >= 0) . assert (i < A.length marr) $ return ()
+#endif
+        A.unsafeWrite marr i (fromIntegral n)
+        return 1
     | otherwise = do
-        assert (i >= 0) . assert (i < A.length marr - 1) $
-          A.unsafeWrite marr i lo
+#if defined(ASSERTS)
+        assert (i >= 0) . assert (i < A.length marr - 1) $ return ()
+#endif
+        A.unsafeWrite marr i lo
         A.unsafeWrite marr (i+1) hi
-        return (i+2)
+        return 2
     where n = ord c
           m = n - 0x10000
           lo = fromIntegral $ (m `shiftR` 10) + 0xD800
diff --git a/tests/Benchmarks.hs b/tests/Benchmarks.hs
--- a/tests/Benchmarks.hs
+++ b/tests/Benchmarks.hs
@@ -8,7 +8,7 @@
 import Criterion.Main
 import Data.Char
 import Data.Monoid (mappend, mempty)
-import qualified Codec.Binary.UTF8.Generic as UTF8
+import qualified Data.ByteString.UTF8 as UTF8
 import qualified Data.Text as TS
 import qualified Data.Text.IO as TS
 import qualified Data.Text.Lazy as TL
@@ -113,6 +113,13 @@
       , bench "bs" $ nf (BS.drop (bsa_len `div` 3)) bsa
       , bench "bl" $ nf (BL.drop (bla_len `div` 3)) bla
       , bench "l" $ nf (L.drop (la_len `div` 3)) la
+      ],
+      bgroup "encode" [
+        bench "ts" $ nf TS.encodeUtf8 tsa
+      , bench "tl" $ nf TL.encodeUtf8 tla
+      , bench "bs" $ nf BS.pack la
+      , bench "bl" $ nf BL.pack la
+      , bench "l" $ nf UTF8.fromString la
       ],
       bgroup "filter" [
         bench "ts" $ nf (TS.filter p0) tsa
diff --git a/tests/Makefile b/tests/Makefile
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -1,11 +1,13 @@
 version := $(shell awk '/^version:/{print $$2}' ../text.cabal)
 ghc := ghc
 ghc-opt-flags = -O0
-ghc-base-flags := -funbox-strict-fields -package criterion \
+ghc-base-flags := -funbox-strict-fields -hide-all-packages \
+	-package base -package mtl -package random -package directory \
+	-package criterion -package deepseq -DASSERTS -DHAVE_DEEPSEQ \
 	-package bytestring -ignore-package text \
 	-fno-ignore-asserts
-ghc-test-flags := -package QuickCheck -package test-framework \
-	-package test-framework-quickcheck -package test-framework-hunit \
+ghc-test-flags := -package QuickCheck -package test-framework -package deepseq \
+	-package test-framework-quickcheck2 -package test-framework-hunit \
 	-package HUnit
 ghc-base-flags += -Wall -fno-warn-orphans -fno-warn-missing-signatures
 ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)
@@ -30,36 +32,50 @@
 	cd .. && cabal build
 endif
 
-Properties.o qc qc-hpc: ghc-flags += $(ghc-test-flags)
-Properties.o: QuickCheckUtils.o SlowFunctions.o
+Properties.o Regressions.o qc qc-hpc: ghc-flags += $(ghc-test-flags)
+Properties.o: QuickCheckUtils.o SlowFunctions.o TestUtils.o
 
 QuickCheckUtils.o: $(lib)
 
-qc: Properties.o QuickCheckUtils.o SlowFunctions.o
+qc: Properties.o QuickCheckUtils.o SlowFunctions.o TestUtils.o
 	$(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)
 
 sb: SearchBench.o SlowFunctions.o
 	$(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)
 
-qc-hpc: Properties.hs QuickCheckUtils.hs $(lib-srcs:%=../%)
+qc-hpc: Properties.hs QuickCheckUtils.hs SlowFunctions.hs TestUtils.hs $(lib-srcs:%=../%)
 	-mkdir -p hpcdir
 	@rm -f $@.tix
-	$(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) -ihpcdir \
+	$(ghc) $(ghc-hpc-flags) $(ghc-test-flags) $(ghc-opt-flags) -ihpcdir \
 	  --make -threaded -o $@ $<
 
-regressions: Regressions.o
-	$(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
+stdio-hpc: StdioCoverage.hs $(lib-srcs:%=../%)
+	-mkdir -p hpcdir
+	@rm -f $@.tix
+	$(ghc) $(ghc-hpc-flags) $(ghc-test-flags) $(ghc-opt-flags) -ihpcdir \
+	  --make -threaded -o $@ $<
 
-coverage: qc-hpc-html/hpc_index.html
+coverage: coverage-html/hpc_index.html
 
-qc-hpc-html/hpc_index.html: qc-hpc
-	./qc-hpc -a 100 +RTS -N2
-	hpc markup qc-hpc --exclude=Main --exclude=Properties \
-	  --exclude=Data.Text.Fusion.CaseMapping \
+coverage-html/hpc_index.html: qc-hpc
+	@rm -f qc-hpc.tix stdio-hpc.tix coverage.tix
+	./qc-hpc -a 100 +RTS -N
+	bash ./cover-stdio.sh
+	hpc combine --output=coverage.tix --exclude=Main \
+	  qc-hpc.tix stdio-hpc.tix
+	hpc markup coverage --exclude=Main --exclude=Properties --exclude=Main \
+	  --exclude=Data.Text.Fusion.CaseMapping --exclude StdioCoverage \
+	  --exclude=SlowFunctions --exclude=TestUtils \
 	  --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)
+	@echo xdg-open $@
 
+Regressions.o: TestUtils.o
+
+regressions: Regressions.o TestUtils.o
+	$(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
+
 Benchmarks.o: ghc-opt-flags = -O
-bm Benchmarks.o: ghc-flags += -hide-package transformers -package utf8-string
+bm Benchmarks.o: ghc-flags += -package utf8-string
 bm: Benchmarks.o
 	$(ghc) $(ghc-flags) -o $@ $^ $(lib)
 
@@ -78,4 +94,4 @@
 	curl -O http://projects.haskell.org/text/text-testdata.tar.bz2
 
 clean:
-	-rm -rf *.o *.hi *.tix bm qc qc-hpc hpcdir .hpc qc-hpc-html
+	-rm -rf *.o *.hi *.tix bm qc qc-hpc stdio-hpc hpcdir .hpc coverage-html
diff --git a/tests/Properties.hs b/tests/Properties.hs
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -2,7 +2,8 @@
              ScopedTypeVariables, TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
 
-import Test.QuickCheck hiding (evaluate)
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
 import Text.Show.Functions ()
 
 import qualified Data.Bits as Bits (shiftL, shiftR)
@@ -11,12 +12,18 @@
 import Data.String (fromString)
 import Debug.Trace (trace)
 import Control.Arrow ((***), second)
+import Control.DeepSeq
 import Data.Word (Word8, Word16, Word32)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
+import qualified Data.Text.Lazy.Internal as TL
 import qualified Data.Text.Lazy.Builder as TB
 import qualified Data.Text.Encoding as E
-import Control.Exception (SomeException, evaluate, try)
+import Data.Text.Encoding.Error
+import Control.Exception (SomeException, bracket, catch, evaluate, try)
+import Data.Text.Foreign
 import qualified Data.Text.Fusion as S
 import qualified Data.Text.Fusion.Common as S
 import Data.Text.Fusion.Size
@@ -24,15 +31,17 @@
 import qualified Data.Text.Lazy.Fusion as SL
 import qualified Data.Text.UnsafeShift as U
 import qualified Data.List as L
-import Prelude hiding (replicate)
+import Prelude hiding (catch, replicate)
+import System.IO
 import System.IO.Unsafe (unsafePerformIO)
 import Test.Framework (defaultMain, testGroup)
-import Test.Framework.Providers.QuickCheck (testProperty)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Data.Text.Search (indices)
 import qualified Data.Text.Lazy.Search as S (indices)
 import qualified SlowFunctions as Slow
 
-import QuickCheckUtils (NotEmpty(..), small)
+import QuickCheckUtils (NotEmpty(..), genUnicode, small, unsquare)
+import TestUtils (withRedirect, withTempFile)
 
 -- Ensure that two potentially bottom values (in the sense of crashing
 -- for some inputs, not looping infinitely) either both crash, or both
@@ -59,16 +68,48 @@
 tl_unstreamChunks x = f 11 x == f 1000 x
     where f n = SL.unstreamChunks n . S.streamList
 tl_chunk_unchunk    = (TL.fromChunks . TL.toChunks) `eq` id
+tl_from_to_strict   = (TL.fromStrict . TL.toStrict) `eq` id
 
-t_ascii t           = E.decodeASCII (E.encodeUtf8 a) == a
-    where a              = T.map (\c -> chr (ord c `mod` 128)) t
-t_utf8              = (E.decodeUtf8 . E.encodeUtf8) `eq` id
-tl_utf8             = (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
-t_utf16LE           = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
-t_utf16BE           = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
-t_utf32LE           = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
-t_utf32BE           = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
+t_ascii t    = E.decodeASCII (E.encodeUtf8 a) == a
+    where a  = T.map (\c -> chr (ord c `mod` 128)) t
+tl_ascii t   = EL.decodeASCII (EL.encodeUtf8 a) == a
+    where a  = TL.map (\c -> chr (ord c `mod` 128)) t
+t_utf8       = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
+tl_utf8      = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id
+t_utf16LE    = forAll genUnicode $ (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
+tl_utf16LE   = forAll genUnicode $ (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id
+t_utf16BE    = forAll genUnicode $ (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id
+tl_utf16BE   = forAll genUnicode $ (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id
+t_utf32LE    = forAll genUnicode $ (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id
+tl_utf32LE   = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
+t_utf32BE    = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
+tl_utf32BE   = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
 
+data DecodeErr = DE String OnDecodeError
+
+instance Show DecodeErr where
+    show (DE d _) = "DE " ++ d
+
+instance CoArbitrary Word8 where
+    coarbitrary = coarbitraryIntegral
+
+instance Arbitrary DecodeErr where
+    arbitrary = oneof [ return $ DE "lenient" lenientDecode
+                      , return $ DE "ignore" ignore
+                      , return $ DE "strict" strictDecode
+                      , DE "replace" `fmap` arbitrary ]
+
+-- This is a poor attempt to ensure that the error handling paths on
+-- decode are exercised in some way.  Proper testing would be rather
+-- more involved.
+t_utf8_err (DE _ de) bs = monadicIO $ do
+  l <- run $ let len = T.length (E.decodeUtf8With de bs)
+             in (len `seq` return (Right len)) `catch`
+                (\(e::UnicodeException) -> return (Left e))
+  case l of
+    Left err -> assert $ length (show err) >= 0
+    Right n  -> assert $ n >= 0
+
 class Stringy s where
     packS    :: String -> s
     unpackS  :: s -> String
@@ -95,7 +136,8 @@
     packSChunkSize k = SL.unstreamChunks k . S.streamList
     packS    = TL.pack
     unpackS  = TL.unpack
-    splitAtS = TL.splitAt . fromIntegral
+    splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .
+               TL.splitAt . fromIntegral
 
 -- Do two functions give the same answer?
 eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
@@ -116,14 +158,9 @@
           m | l == 0    = n
             | otherwise = n `mod` l
           n             = fromIntegral w
-          eql d a b | a =^= b   = True
-                    | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
-
--- For tests that have O(n^2) running times or input sizes, resize
--- their inputs to the square root of the originals.
-unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
-unsquare = forAll . sized $ \n -> resize (smallish n) arbitrary
-    where smallish = round . (sqrt :: Double -> Double) . fromIntegral
+          eql d a b
+            | a =^= b   = True
+            | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
 
 s_Eq s            = (s==)    `eq` ((S.streamList s==) . S.streamList)
     where _types = s :: String
@@ -145,8 +182,8 @@
 tl_Show           = show     `eq` (show . TL.pack)
 t_mappend s       = mappend s`eqP` (unpackS . mappend (T.pack s))
 tl_mappend s      = mappend s`eqP` (unpackS . mappend (TL.pack s))
-t_mconcat         = unsquare (mconcat `eq` (unpackS . mconcat . L.map T.pack))
-tl_mconcat        = unsquare (mconcat `eq` (unpackS . mconcat . L.map TL.pack))
+t_mconcat         = mconcat `eq` (unpackS . mconcat . L.map T.pack)
+tl_mconcat        = mconcat `eq` (unpackS . mconcat . L.map TL.pack)
 t_IsString        = fromString  `eqP` (T.unpack . fromString)
 tl_IsString       = fromString  `eqP` (TL.unpack . fromString)
 
@@ -159,15 +196,18 @@
 t_snoc x          = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
 tl_snoc x         = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
 s_append s        = (s++)    `eqP` (unpackS . S.append (S.streamList s))
-s_append_s s      = (s++)    `eqP` (unpackS . S.unstream . S.append (S.streamList s))
-sf_append p s     = (L.filter p s++) `eqP` (unpackS . S.append (S.filter p $ S.streamList s))
+s_append_s s      = (s++)    `eqP`
+                    (unpackS . S.unstream . S.append (S.streamList s))
+sf_append p s     = (L.filter p s++) `eqP`
+                    (unpackS . S.append (S.filter p $ S.streamList s))
 t_append s        = (s++)    `eqP` (unpackS . T.append (packS s))
 
 uncons (x:xs) = Just (x,xs)
 uncons _      = Nothing
 
 s_uncons          = uncons   `eqP` (fmap (second unpackS) . S.uncons)
-sf_uncons p       = (uncons . L.filter p) `eqP` (fmap (second unpackS) . S.uncons . S.filter p)
+sf_uncons p       = (uncons . L.filter p) `eqP`
+                    (fmap (second unpackS) . S.uncons . S.filter p)
 t_uncons          = uncons   `eqP` (fmap (second unpackS) . T.uncons)
 tl_uncons         = uncons   `eqP` (fmap (second unpackS) . TL.uncons)
 s_head            = head   `eqP` S.head
@@ -194,29 +234,39 @@
 tl_null           = null   `eqP` TL.null
 s_length          = length `eqP` S.length
 sf_length p       = (length . L.filter p) `eqP` (S.length . S.filter p)
+sl_length         = (fromIntegral . length) `eqP` SL.length
 t_length          = length `eqP` T.length
-tl_length         = length `eqP` (fromIntegral . TL.length)
+tl_length         = L.genericLength `eqP` TL.length
+t_compareLength t = (compare (T.length t)) `eq` T.compareLength t
+tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t
 
 s_map f           = map f  `eqP` (unpackS . S.map f)
 s_map_s f         = map f  `eqP` (unpackS . S.unstream . S.map f)
 sf_map p f        = (map f . L.filter p)  `eqP` (unpackS . S.map f . S.filter p)
 t_map f           = map f  `eqP` (unpackS . T.map f)
 tl_map f          = map f  `eqP` (unpackS . TL.map f)
-t_intercalate c   = unsquare (L.intercalate c `eq` (unpackS . T.intercalate (packS c) . map packS))
-tl_intercalate c  = unsquare (L.intercalate c `eq` (unpackS . TL.intercalate (TL.pack c) . map TL.pack))
-s_intersperse c   = L.intersperse c `eqP` (unpackS . S.intersperse c)
-s_intersperse_s c = L.intersperse c `eqP` (unpackS . S.unstream . S.intersperse c)
-sf_intersperse p c= (L.intersperse c . L.filter p) `eqP` (unpackS . S.intersperse c . S.filter p)
+t_intercalate c   = L.intercalate c `eq`
+                    (unpackS . T.intercalate (packS c) . map packS)
+tl_intercalate c  = L.intercalate c `eq`
+                    (unpackS . TL.intercalate (TL.pack c) . map TL.pack)
+s_intersperse c   = L.intersperse c `eqP`
+                    (unpackS . S.intersperse c)
+s_intersperse_s c = L.intersperse c `eqP`
+                    (unpackS . S.unstream . S.intersperse c)
+sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`
+                   (unpackS . S.intersperse c . S.filter p)
 t_intersperse c   = L.intersperse c `eqP` (unpackS . T.intersperse c)
 tl_intersperse c  = L.intersperse c `eqP` (unpackS . TL.intersperse c)
-t_transpose       = unsquare (L.transpose `eq` (map unpackS . T.transpose . map packS))
-tl_transpose      = unsquare (L.transpose `eq` (map unpackS . TL.transpose . map TL.pack))
+t_transpose       = L.transpose `eq` (map unpackS . T.transpose . map packS)
+tl_transpose      = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)
 t_reverse         = L.reverse `eqP` (unpackS . T.reverse)
 tl_reverse        = L.reverse `eqP` (unpackS . TL.reverse)
 t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)
 
-t_replace s d     = (L.intercalate d . split s) `eqP` (unpackS . T.replace (T.pack s) (T.pack d))
-tl_replace s d     = (L.intercalate d . split s) `eqP` (unpackS . TL.replace (TL.pack s) (TL.pack d))
+t_replace s d     = (L.intercalate d . split s) `eqP`
+                    (unpackS . T.replace (T.pack s) (T.pack d))
+tl_replace s d     = (L.intercalate d . split s) `eqP`
+                     (unpackS . TL.replace (TL.pack s) (TL.pack d))
 
 split :: (Eq a) => [a] -> [a] -> [[a]]
 split pat src0
@@ -249,25 +299,47 @@
 tl_toUpper_upper t = p (TL.toUpper t) >= p t
     where p = TL.length . TL.filter isUpper
 
-justifyLeft k c s  = s ++ L.replicate (k - length s) c
-justifyRight m n s = L.replicate (m - length s) n ++ s
+justifyLeft k c xs  = xs ++ L.replicate (k - length xs) c
+justifyRight m n xs = L.replicate (m - length xs) n ++ xs
+center k c xs
+    | len >= k  = xs
+    | otherwise = L.replicate l c ++ xs ++ L.replicate r c
+   where len = length xs
+         d   = k - len
+         r   = d `div` 2
+         l   = d - r
 
-s_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeftI k c)
-s_justifyLeft_s k c = justifyLeft k c `eqP` (unpackS . S.unstream . S.justifyLeftI k c)
-sf_justifyLeft p k c =
-    (justifyLeft k c . L.filter p) `eqP` (unpackS . S.justifyLeftI k c . S.filter p)
-t_justifyLeft k c = justifyLeft k c `eqP` (unpackS . T.justifyLeft k c)
-tl_justifyLeft k c = justifyLeft k c `eqP` (unpackS . TL.justifyLeft (fromIntegral k) c)
-t_justifyRight k c = justifyRight k c `eqP` (unpackS . T.justifyRight k c)
-tl_justifyRight k c = justifyRight k c `eqP` (unpackS . TL.justifyRight (fromIntegral k) c)
+s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)
+    where j = fromIntegral (k :: Word8)
+s_justifyLeft_s k c = justifyLeft j c `eqP`
+                      (unpackS . S.unstream . S.justifyLeftI j c)
+    where j = fromIntegral (k :: Word8)
+sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`
+                       (unpackS . S.justifyLeftI j c . S.filter p)
+    where j = fromIntegral (k :: Word8)
+t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)
+    where j = fromIntegral (k :: Word8)
+tl_justifyLeft k c = justifyLeft j c `eqP`
+                     (unpackS . TL.justifyLeft (fromIntegral j) c)
+    where j = fromIntegral (k :: Word8)
+t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)
+    where j = fromIntegral (k :: Word8)
+tl_justifyRight k c = justifyRight j c `eqP`
+                      (unpackS . TL.justifyRight (fromIntegral j) c)
+    where j = fromIntegral (k :: Word8)
+t_center k c = center j c `eqP` (unpackS . T.center j c)
+    where j = fromIntegral (k :: Word8)
+tl_center k c = center j c `eqP` (unpackS . TL.center (fromIntegral j) c)
+    where j = fromIntegral (k :: Word8)
 
-sf_foldl p f z     = (L.foldl f z . L.filter p)  `eqP` (S.foldl f z . S.filter p)
+sf_foldl p f z    = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)
     where _types  = f :: Char -> Char -> Char
 t_foldl f z       = L.foldl f z  `eqP` (T.foldl f z)
     where _types  = f :: Char -> Char -> Char
 tl_foldl f z      = L.foldl f z  `eqP` (TL.foldl f z)
     where _types  = f :: Char -> Char -> Char
-sf_foldl' p f z   = (L.foldl' f z . L.filter p) `eqP` (S.foldl' f z . S.filter p)
+sf_foldl' p f z   = (L.foldl' f z . L.filter p) `eqP`
+                    (S.foldl' f z . S.filter p)
     where _types  = f :: Char -> Char -> Char
 t_foldl' f z      = L.foldl' f z `eqP` T.foldl' f z
     where _types  = f :: Char -> Char -> Char
@@ -289,13 +361,17 @@
 t_foldr1 f        = L.foldr1 f   `eqP` T.foldr1 f
 tl_foldr1 f       = L.foldr1 f   `eqP` TL.foldr1 f
 
-s_concat_s        = unsquare (L.concat `eq` (unpackS . S.unstream . S.concat . map packS))
-sf_concat p       = unsquare ((L.concat . map (L.filter p)) `eq` (unpackS . S.concat . map (S.filter p . packS)))
-t_concat          = unsquare (L.concat `eq` (unpackS . T.concat . map packS))
-tl_concat         = unsquare (L.concat `eq` (unpackS . TL.concat . map TL.pack))
-sf_concatMap p f  = unsquare ((L.concatMap f . L.filter p) `eqP` (unpackS . S.concatMap (packS . f) . S.filter p))
-t_concatMap f     = unsquare (L.concatMap f `eqP` (unpackS . T.concatMap (packS . f)))
-tl_concatMap f    = unsquare (L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f)))
+s_concat_s        = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
+sf_concat p       = (L.concat . map (L.filter p)) `eq`
+                    (unpackS . S.concat . map (S.filter p . packS))
+t_concat          = L.concat `eq` (unpackS . T.concat . map packS)
+tl_concat         = L.concat `eq` (unpackS . TL.concat . map TL.pack)
+sf_concatMap p f  = unsquare $ (L.concatMap f . L.filter p) `eqP`
+                               (unpackS . S.concatMap (packS . f) . S.filter p)
+t_concatMap f     = unsquare $
+                    L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))
+tl_concatMap f    = unsquare $
+                    L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))
 sf_any q p        = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)
 t_any p           = L.any p       `eqP` T.any p
 tl_any p          = L.any p       `eqP` TL.any p
@@ -309,7 +385,8 @@
 t_minimum         = L.minimum     `eqP` T.minimum
 tl_minimum        = L.minimum     `eqP` TL.minimum
 
-sf_scanl p f z    = (L.scanl f z . L.filter p) `eqP` (unpackS . S.scanl f z . S.filter p)
+sf_scanl p f z    = (L.scanl f z . L.filter p) `eqP`
+                    (unpackS . S.scanl f z . S.filter p)
 t_scanl f z       = L.scanl f z   `eqP` (unpackS . T.scanl f z)
 tl_scanl f z      = L.scanl f z   `eqP` (unpackS . TL.scanl f z)
 t_scanl1 f        = L.scanl1 f    `eqP` (unpackS . T.scanl1 f)
@@ -319,30 +396,39 @@
 t_scanr1 f        = L.scanr1 f    `eqP` (unpackS . T.scanr1 f)
 tl_scanr1 f       = L.scanr1 f    `eqP` (unpackS . TL.scanr1 f)
 
-t_mapAccumL f z   = unsquare (L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z))
-    where _types = f :: Int -> Char -> (Int,Char)
-tl_mapAccumL f z  = unsquare (L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z))
-    where _types = f :: Int -> Char -> (Int,Char)
-t_mapAccumR f z   = unsquare (L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z))
-    where _types = f :: Int -> Char -> (Int,Char)
-tl_mapAccumR f z   = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))
-    where _types = f :: Int -> Char -> (Int,Char)
+t_mapAccumL f z   = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)
+    where _types  = f :: Int -> Char -> (Int,Char)
+tl_mapAccumL f z  = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)
+    where _types  = f :: Int -> Char -> (Int,Char)
+t_mapAccumR f z   = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
+    where _types  = f :: Int -> Char -> (Int,Char)
+tl_mapAccumR f z  = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
+    where _types  = f :: Int -> Char -> (Int,Char)
 
 replicate n l = concat (L.replicate n l)
 
-t_replicate n     = replicate n `eq` (unpackS . T.replicate n . packS)
-tl_replicate n    = replicate n `eq` (unpackS . TL.replicate (fromIntegral n) . packS)
+t_replicate n     = replicate m `eq` (unpackS . T.replicate m . packS)
+    where m = fromIntegral (n :: Word8)
+tl_replicate n    = replicate m `eq`
+                    (unpackS . TL.replicate (fromIntegral m) . packS)
+    where m = fromIntegral (n :: Word8)
 
 unf :: Int -> Char -> Maybe (Char, Char)
 unf n c | fromEnum c * 100 > n = Nothing
         | otherwise            = Just (c, succ c)
 
-t_unfoldr n       = L.unfoldr (unf n) `eq` (unpackS . T.unfoldr (unf n))
-tl_unfoldr n      = L.unfoldr (unf n) `eq` (unpackS . TL.unfoldr (unf n))
-t_unfoldrN n m    = (L.take n . L.unfoldr (unf m)) `eq`
-                         (unpackS . T.unfoldrN n (unf m))
-tl_unfoldrN n m   = (L.take n . L.unfoldr (unf m)) `eq`
-                         (unpackS . TL.unfoldrN (fromIntegral n) (unf m))
+t_unfoldr n       = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))
+    where m = fromIntegral (n :: Word16)
+tl_unfoldr n      = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))
+    where m = fromIntegral (n :: Word16)
+t_unfoldrN n m    = (L.take i . L.unfoldr (unf j)) `eq`
+                         (unpackS . T.unfoldrN i (unf j))
+    where i = fromIntegral (n :: Word16)
+          j = fromIntegral (m :: Word16)
+tl_unfoldrN n m   = (L.take i . L.unfoldr (unf j)) `eq`
+                         (unpackS . TL.unfoldrN (fromIntegral i) (unf j))
+    where i = fromIntegral (n :: Word16)
+          j = fromIntegral (m :: Word16)
 
 unpack2 :: (Stringy s) => (s,s) -> (String,String)
 unpack2 = unpackS *** unpackS
@@ -350,33 +436,42 @@
 s_take n          = L.take n      `eqP` (unpackS . S.take n)
 s_take_s m        = L.take n      `eqP` (unpackS . S.unstream . S.take n)
   where n = small m
-sf_take p n       = (L.take n . L.filter p) `eqP` (unpackS . S.take n . S.filter p)
+sf_take p n       = (L.take n . L.filter p) `eqP`
+                    (unpackS . S.take n . S.filter p)
 t_take n          = L.take n      `eqP` (unpackS . T.take n)
 tl_take n         = L.take n      `eqP` (unpackS . TL.take (fromIntegral n))
 s_drop n          = L.drop n      `eqP` (unpackS . S.drop n)
 s_drop_s m        = L.drop n      `eqP` (unpackS . S.unstream . S.drop n)
   where n = small m
-sf_drop p n       = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p)
+sf_drop p n       = (L.drop n . L.filter p) `eqP`
+                    (unpackS . S.drop n . S.filter p)
 t_drop n          = L.drop n      `eqP` (unpackS . T.drop n)
 tl_drop n         = L.drop n      `eqP` (unpackS . TL.drop (fromIntegral n))
 s_take_drop m     = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
   where n = small m
-s_take_drop_s m   = (L.take n . L.drop n) `eqP` (unpackS . S.unstream . S.take n . S.drop n)
+s_take_drop_s m   = (L.take n . L.drop n) `eqP`
+                    (unpackS . S.unstream . S.take n . S.drop n)
   where n = small m
 s_takeWhile p     = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
 s_takeWhile_s p   = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
-sf_takeWhile q p  = (L.takeWhile p . L.filter q) `eqP` (unpackS . S.takeWhile p . S.filter q)
+sf_takeWhile q p  = (L.takeWhile p . L.filter q) `eqP`
+                    (unpackS . S.takeWhile p . S.filter q)
 t_takeWhile p     = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
 tl_takeWhile p    = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
 s_dropWhile p     = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
 s_dropWhile_s p   = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
-sf_dropWhile q p  = (L.dropWhile p . L.filter q) `eqP` (unpackS . S.dropWhile p . S.filter q)
+sf_dropWhile q p  = (L.dropWhile p . L.filter q) `eqP`
+                    (unpackS . S.dropWhile p . S.filter q)
 t_dropWhile p     = L.dropWhile p `eqP` (unpackS . T.dropWhile p)
 tl_dropWhile p    = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
-t_dropWhileEnd p  = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropWhileEnd p)
-tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropWhileEnd p)
-t_dropAround p    = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropAround p)
-tl_dropAround p   = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropAround p)
+t_dropWhileEnd p  = (L.reverse . L.dropWhile p . L.reverse) `eqP`
+                    (unpackS . T.dropWhileEnd p)
+tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`
+                    (unpackS . TL.dropWhileEnd p)
+t_dropAround p    = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)
+                    `eqP` (unpackS . T.dropAround p)
+tl_dropAround p   = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)
+                    `eqP` (unpackS . TL.dropAround p)
 t_stripStart      = T.dropWhile isSpace `eq` T.stripStart
 tl_stripStart     = TL.dropWhile isSpace `eq` TL.stripStart
 t_stripEnd        = T.dropWhileEnd isSpace `eq` T.stripEnd
@@ -398,6 +493,10 @@
                                in T.null m || s `T.isPrefixOf` m
 tl_break_start (NotEmpty s) t = let (_,m) = TL.break s t
                                 in TL.null m || s `TL.isPrefixOf` m
+t_breakEnd_end (NotEmpty s) t = let (m,_) = T.breakEnd s t
+                                in T.null m || s `T.isSuffixOf` m
+tl_breakEnd_end (NotEmpty s) t = let (m,_) = TL.breakEnd s t
+                                in TL.null m || s `TL.isSuffixOf` m
 t_breakBy p       = L.break p     `eqP` (unpack2 . T.breakBy p)
 tl_breakBy p      = L.break p     `eqP` (unpack2 . TL.breakBy p)
 t_group           = L.group       `eqP` (map unpackS . T.group)
@@ -408,25 +507,29 @@
 tl_inits          = L.inits       `eqP` (map unpackS . TL.inits)
 t_tails           = L.tails       `eqP` (map unpackS . T.tails)
 tl_tails          = L.tails       `eqP` (map unpackS . TL.tails)
+t_findAppendId (NotEmpty s) = unsquare $ \ts ->
+    let t = T.intercalate s ts
+    in all (==t) $ map (uncurry T.append) (T.find s t)
+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->
+    let t = TL.intercalate s ts
+    in all (==t) $ map (uncurry TL.append) (TL.find s t)
+t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.find s .
+                              T.intercalate s
+tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .
+                               TL.find s . TL.intercalate s
+sl_filterCount c  = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c
+t_findCount s     = (L.length . T.find s) `eq` T.count s
+tl_findCount s    = (L.genericLength . TL.find s) `eq` TL.count s
 
-t_findSplit s t         = (T.split s `eq` splitty) u
-  where splitty v       = case T.find s v  of
-                            (x,xs) -> x : L.map (T.drop (T.length s) . fst) xs
-        u = T.concat [t,s,t]
-tl_findSplit s t        = (TL.split s `eq` splitty) u
-  where splitty v       = case TL.find s v of
-                            (x,xs) -> x : L.map (TL.drop (TL.length s) . fst) xs
-        u = TL.concat [t,s,t]
-t_split_split s         = unsquare ((T.split s `eq` Slow.split s) .
-                                    T.intercalate s)
-tl_split_split s        = unsquare (((TL.split (chunkify s) . chunkify) `eq`
-                                     (map chunkify . T.split s)) .
-                                    T.intercalate s)
+t_split_split s         = (T.split s `eq` Slow.split s) . T.intercalate s
+tl_split_split s        = ((TL.split (TL.fromStrict s) . TL.fromStrict) `eq`
+                           (map TL.fromStrict . T.split s)) . T.intercalate s
 t_split_i (NotEmpty t)  = id `eq` (T.intercalate t . T.split t)
 tl_split_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.split t)
 
 t_splitBy p       = splitBy p `eqP` (map unpackS . T.splitBy p)
-t_splitBy_count c = (L.length . T.splitBy (==c)) `eq` ((1+) . T.count (T.singleton c))
+t_splitBy_count c = (L.length . T.splitBy (==c)) `eq`
+                    ((1+) . T.count (T.singleton c))
 t_splitBy_split c = T.splitBy (==c) `eq` T.split (T.singleton c)
 tl_splitBy p      = splitBy p `eqP` (map unpackS . TL.splitBy p)
 
@@ -444,9 +547,8 @@
 t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)
   where len = L.sum . L.map T.length $ T.chunksOf k t
 
-chunkify = TL.fromChunks . (:[])
-
-tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) . TL.chunksOf (fromIntegral k) . chunkify)
+tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) .
+                                   TL.chunksOf (fromIntegral k) . TL.fromStrict)
 
 t_lines           = L.lines       `eqP` (map unpackS . T.lines)
 tl_lines          = L.lines       `eqP` (map unpackS . TL.lines)
@@ -463,13 +565,15 @@
 t_words           = L.words       `eqP` (map unpackS . T.words)
 
 tl_words          = L.words       `eqP` (map unpackS . TL.words)
-t_unlines         = unsquare (L.unlines `eq` (unpackS . T.unlines . map packS))
-tl_unlines        = unsquare (L.unlines `eq` (unpackS . TL.unlines . map packS))
-t_unwords         = unsquare (L.unwords `eq` (unpackS . T.unwords . map packS))
-tl_unwords        = unsquare (L.unwords `eq` (unpackS . TL.unwords . map packS))
+t_unlines         = L.unlines `eq` (unpackS . T.unlines . map packS)
+tl_unlines        = L.unlines `eq` (unpackS . TL.unlines . map packS)
+t_unwords         = L.unwords `eq` (unpackS . T.unwords . map packS)
+tl_unwords        = L.unwords `eq` (unpackS . TL.unwords . map packS)
 
-s_isPrefixOf s    = L.isPrefixOf s `eqP` (S.isPrefixOf (S.stream $ packS s) . S.stream)
-sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP` (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)
+s_isPrefixOf s    = L.isPrefixOf s `eqP`
+                    (S.isPrefixOf (S.stream $ packS s) . S.stream)
+sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP`
+                    (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)
 t_isPrefixOf s    = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)
 tl_isPrefixOf s   = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)
 t_isSuffixOf s    = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)
@@ -477,8 +581,22 @@
 t_isInfixOf s     = L.isInfixOf s `eqP` T.isInfixOf (packS s)
 tl_isInfixOf s    = L.isInfixOf s `eqP` TL.isInfixOf (packS s)
 
+prefixed (p:ps) (t:ts)
+    | p == t = prefixed ps ts
+prefixed [] ts = Just ts
+prefixed _  _  = Nothing
+
+t_prefixed s      = (fmap packS . prefixed s) `eqP` T.prefixed (packS s)
+tl_prefixed s     = (fmap packS . prefixed s) `eqP` TL.prefixed (packS s)
+
+suffixed p t = reverse `fmap` prefixed (reverse p) (reverse t)
+
+t_suffixed s      = (fmap packS . suffixed s) `eqP` T.suffixed (packS s)
+tl_suffixed s     = (fmap packS . suffixed s) `eqP` TL.suffixed (packS s)
+
 sf_elem p c       = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)
-sf_filter q p     = (L.filter p . L.filter q) `eqP` (unpackS . S.filter p . S.filter q)
+sf_filter q p     = (L.filter p . L.filter q) `eqP`
+                    (unpackS . S.filter p . S.filter q)
 t_filter p        = L.filter p    `eqP` (unpackS . T.filter p)
 tl_filter p       = L.filter p    `eqP` (unpackS . TL.filter p)
 sf_findBy q p     = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)
@@ -487,29 +605,33 @@
 t_partition p     = L.partition p `eqP` (unpack2 . T.partitionBy p)
 tl_partition p    = L.partition p `eqP` (unpack2 . TL.partitionBy p)
 
-sf_index p s      = forAll (choose (-l,l*2)) ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))
+sf_index p s      = forAll (choose (-l,l*2))
+                    ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))
     where l = L.length s
 t_index s         = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))
     where l = L.length s
 
-tl_index s        = forAll (choose (-l,l*2)) ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))
+tl_index s        = forAll (choose (-l,l*2))
+                    ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))
     where l = L.length s
 
 t_findIndex p     = L.findIndex p `eqP` T.findIndex p
-t_count t         = (subtract 1 . L.length . T.split t) `eq` T.count t
-tl_count t        = (subtract 1 . L.genericLength . TL.split t) `eq` TL.count t
+t_count (NotEmpty t)  = (subtract 1 . L.length . T.split t) `eq` T.count t
+tl_count (NotEmpty t) = (subtract 1 . L.genericLength . TL.split t) `eq`
+                        TL.count t
 t_zip s           = L.zip s `eqP` T.zip (packS s)
 tl_zip s          = L.zip s `eqP` TL.zip (packS s)
-sf_zipWith p c s  = (L.zipWith c (L.filter p s) . L.filter p) `eqP` (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)
+sf_zipWith p c s  = (L.zipWith c (L.filter p s) . L.filter p) `eqP`
+                    (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)
 t_zipWith c s     = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))
 tl_zipWith c s    = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))
 
-t_indices = unsquare (\s -> Slow.indices s `eq` indices s)
-tl_indices = unsquare (\s -> lazyIndices s `eq` S.indices s)
-    where lazyIndices s t = map fromIntegral $ Slow.indices (conc s) (conc t)
+t_indices  (NotEmpty s) = Slow.indices s `eq` indices s
+tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
+    where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)
           conc = T.concat . TL.toChunks
-t_indices_occurs t = unsquare (\ts -> let s = T.intercalate t ts
-                                      in Slow.indices t s == indices t s)
+t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts
+                                   in Slow.indices t s == indices t s
 
 -- Bit shifts.
 shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -526,15 +648,103 @@
 shiftR_Word16 = shiftR :: Word16 -> Property
 shiftR_Word32 = shiftR :: Word32 -> Property
 
--- Builder
-t_builderSingleton = id `eqP` (unpackS . TB.toLazyText . mconcat . map TB.singleton)
-t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat . map (TB.fromText . packS))
-t_builderAssociative s1 s2 s3 = TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
-                                TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
-    where b1 = TB.fromText (packS s1)
-          b2 = TB.fromText (packS s2)
-          b3 = TB.fromText (packS s3)
+-- Builder.
 
+t_builderSingleton = id `eqP`
+                     (unpackS . TB.toLazyText . mconcat . map TB.singleton)
+t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .
+                                   map (TB.fromText . packS))
+t_builderAssociative s1 s2 s3 =
+    TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
+    TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
+  where b1 = TB.fromText (packS s1)
+        b2 = TB.fromText (packS s2)
+        b3 = TB.fromText (packS s3)
+
+-- Input and output.
+
+-- Work around lack of Show instance for TextEncoding.
+data Encoding = E String TextEncoding
+
+instance Show Encoding where show (E n _) = "utf" ++ n
+
+instance Arbitrary Encoding where
+    arbitrary = oneof . map return $
+      [ E "8" utf8, E "8_bom" utf8_bom, E "16" utf16, E "16le" utf16le,
+        E "16be" utf16be, E "32" utf32, E "32le" utf32le, E "32be" utf32be ]
+
+windowsNewlineMode  = NewlineMode { inputNL = CRLF, outputNL = CRLF }
+
+instance Show Newline where
+    show CRLF = "CRLF"
+    show LF   = "LF"
+
+instance Show NewlineMode where
+    show (NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
+                             ", outputNL = " ++ show o ++ " }"
+
+instance Arbitrary NewlineMode where
+    arbitrary = oneof . map return $
+      [ noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
+        windowsNewlineMode ]
+
+instance Arbitrary BufferMode where
+    arbitrary = oneof [ return NoBuffering,
+                        return LineBuffering,
+                        return (BlockBuffering Nothing),
+                        (BlockBuffering . Just . (+1) . fromIntegral) `fmap`
+                        (arbitrary :: Gen Word16) ]
+
+-- This test harness is complex!  What property are we checking?
+--
+-- Reading after writing a multi-line file should give the same
+-- results as were written.
+--
+-- What do we vary while checking this property?
+-- * The lines themselves, scrubbed to contain neither CR nor LF.  (By
+--   working with a list of lines, we ensure that the data will
+--   sometimes contain line endings.)
+-- * Encoding.
+-- * Newline translation mode.
+-- * Buffering.
+write_read unline filt writer reader (E _ enc) nl buf ts =
+    monadicIO $ assert . (==t) =<< run act
+  where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
+        act = withTempFile $ \path h -> do
+                hSetEncoding h enc
+                hSetNewlineMode h nl
+                hSetBuffering h buf
+                () <- writer h t
+                hClose h
+                bracket (openFile path ReadMode) hClose $ \h' -> do
+                  hSetEncoding h' enc
+                  hSetNewlineMode h' nl
+                  hSetBuffering h' buf
+                  r <- reader h'
+                  r `deepseq` return r
+
+t_put_get = write_read T.unlines T.filter put get
+  where put h = withRedirect h stdout . T.putStr
+        get h = withRedirect h stdin T.getContents
+tl_put_get = write_read TL.unlines TL.filter put get
+  where put h = withRedirect h stdout . TL.putStr
+        get h = withRedirect h stdin TL.getContents
+t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
+tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
+
+t_write_read_line e m b t = write_read head T.filter T.hPutStrLn
+                            T.hGetLine e m b [t]
+tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
+                             TL.hGetLine e m b [t]
+
+-- Low-level.
+
+t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
+t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
+  where n = small m
+t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
+
 -- Regression tests.
 s_filter_eq s = S.filter p t == S.streamList (filter p s)
     where p = (/= S.last t)
@@ -560,17 +770,26 @@
     testProperty "t_singleton" t_singleton,
     testProperty "tl_singleton" tl_singleton,
     testProperty "tl_unstreamChunks" tl_unstreamChunks,
-    testProperty "tl_chunk_unchunk" tl_chunk_unchunk
+    testProperty "tl_chunk_unchunk" tl_chunk_unchunk,
+    testProperty "tl_from_to_strict" tl_from_to_strict
   ],
 
   testGroup "transcoding" [
     testProperty "t_ascii" t_ascii,
+    testProperty "tl_ascii" tl_ascii,
     testProperty "t_utf8" t_utf8,
     testProperty "tl_utf8" tl_utf8,
     testProperty "t_utf16LE" t_utf16LE,
+    testProperty "tl_utf16LE" tl_utf16LE,
     testProperty "t_utf16BE" t_utf16BE,
+    testProperty "tl_utf16BE" tl_utf16BE,
     testProperty "t_utf32LE" t_utf32LE,
-    testProperty "t_utf32BE" t_utf32BE
+    testProperty "tl_utf32LE" tl_utf32LE,
+    testProperty "t_utf32BE" t_utf32BE,
+    testProperty "tl_utf32BE" tl_utf32BE,
+    testGroup "errors" [
+      testProperty "t_utf8_err" t_utf8_err
+    ]
   ],
 
   testGroup "instances" [
@@ -635,8 +854,11 @@
     testProperty "tl_null" tl_null,
     testProperty "s_length" s_length,
     testProperty "sf_length" sf_length,
+    testProperty "sl_length" sl_length,
     testProperty "t_length" t_length,
-    testProperty "tl_length" tl_length
+    testProperty "tl_length" tl_length,
+    testProperty "t_compareLength" t_compareLength,
+    testProperty "tl_compareLength" tl_compareLength
   ],
 
   testGroup "transformations" [
@@ -680,7 +902,9 @@
       testProperty "t_justifyLeft" t_justifyLeft,
       testProperty "tl_justifyLeft" tl_justifyLeft,
       testProperty "t_justifyRight" t_justifyRight,
-      testProperty "tl_justifyRight" tl_justifyRight
+      testProperty "tl_justifyRight" tl_justifyRight,
+      testProperty "t_center" t_center,
+      testProperty "tl_center" tl_center
     ]
   ],
 
@@ -799,6 +1023,8 @@
       testProperty "tl_break_id" tl_break_id,
       testProperty "t_break_start" t_break_start,
       testProperty "tl_break_start" tl_break_start,
+      testProperty "t_breakEnd_end" t_breakEnd_end,
+      testProperty "tl_breakEnd_end" tl_breakEnd_end,
       testProperty "t_breakBy" t_breakBy,
       testProperty "tl_breakBy" tl_breakBy,
       testProperty "t_group" t_group,
@@ -812,8 +1038,13 @@
     ],
 
     testGroup "breaking many" [
-      testProperty "t_findSplit" t_findSplit,
-      testProperty "tl_findSplit" tl_findSplit,
+      testProperty "t_findAppendId" t_findAppendId,
+      testProperty "tl_findAppendId" tl_findAppendId,
+      testProperty "t_findContains" t_findContains,
+      testProperty "tl_findContains" tl_findContains,
+      testProperty "sl_filterCount" sl_filterCount,
+      testProperty "t_findCount" t_findCount,
+      testProperty "tl_findCount" tl_findCount,
       testProperty "t_split_split" t_split_split,
       testProperty "tl_split_split" tl_split_split,
       testProperty "t_split_i" t_split_i,
@@ -848,7 +1079,14 @@
     testProperty "t_isSuffixOf" t_isSuffixOf,
     testProperty "tl_isSuffixOf" tl_isSuffixOf,
     testProperty "t_isInfixOf" t_isInfixOf,
-    testProperty "tl_isInfixOf" tl_isInfixOf
+    testProperty "tl_isInfixOf" tl_isInfixOf,
+
+    testGroup "view" [
+      testProperty "t_prefixed" t_prefixed,
+      testProperty "tl_prefixed" tl_prefixed,
+      testProperty "t_suffixed" t_suffixed,
+      testProperty "tl_suffixed" tl_suffixed
+    ]
   ],
 
   testGroup "searching" [
@@ -900,5 +1138,23 @@
     testProperty "t_builderSingleton" t_builderSingleton,
     testProperty "t_builderFromText" t_builderFromText,
     testProperty "t_builderAssociative" t_builderAssociative
+  ],
+
+  testGroup "input-output" [
+    testProperty "t_write_read" t_write_read,
+    testProperty "tl_write_read" tl_write_read,
+    testProperty "t_write_read_line" t_write_read_line,
+    testProperty "tl_write_read_line" tl_write_read_line
+    -- These tests are subject to I/O race conditions when run under
+    -- test-framework-quickcheck2.
+    -- testProperty "t_put_get" t_put_get
+    -- testProperty "tl_put_get" tl_put_get
+  ],
+
+  testGroup "lowlevel" [
+    testProperty "t_dropWord16" t_dropWord16,
+    testProperty "t_takeWord16" t_takeWord16,
+    testProperty "t_take_drop_16" t_take_drop_16,
+    testProperty "t_use_from" t_use_from
   ]
  ]
diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs
--- a/tests/QuickCheckUtils.hs
+++ b/tests/QuickCheckUtils.hs
@@ -3,12 +3,15 @@
 module QuickCheckUtils where
 
 import Control.Arrow (first)
+import Data.Char (chr)
+import Data.Bits ((.&.))
 import Data.Int (Int64)
 import Data.Word (Word8, Word16, Word32)
+import Data.String (IsString, fromString)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import System.Random (Random(..), RandomGen)
-import Test.QuickCheck (Arbitrary(..), choose, oneof, sized, variant, vector)
+import Test.QuickCheck hiding ((.&.))
 import qualified Data.ByteString as B
 
 instance Random Int64 where
@@ -17,7 +20,6 @@
 
 instance Arbitrary Int64 where
     arbitrary     = choose (minBound,maxBound)
-    coarbitrary c = variant (fromEnum c `rem` 4)
 
 instance Random Word8 where
     randomR = integralRandomR
@@ -25,11 +27,9 @@
 
 instance Arbitrary Word8 where
     arbitrary     = choose (minBound,maxBound)
-    coarbitrary c = variant (fromEnum c `rem` 4)
 
 instance Arbitrary B.ByteString where
     arbitrary     = B.pack `fmap` arbitrary
-    coarbitrary s = coarbitrary (B.unpack s)
 
 instance Random Word16 where
     randomR = integralRandomR
@@ -37,7 +37,6 @@
 
 instance Arbitrary Word16 where
     arbitrary     = choose (minBound,maxBound)
-    coarbitrary c = variant (fromEnum c `rem` 4)
 
 instance Random Word32 where
     randomR = integralRandomR
@@ -45,41 +44,92 @@
 
 instance Arbitrary Word32 where
     arbitrary     = choose (minBound,maxBound)
-    coarbitrary c = variant (fromEnum c `rem` 4)
 
-instance Arbitrary Char where
-    arbitrary     = oneof [choose ('\0','\55295'), choose ('\57344','\1114111')]
-    coarbitrary c = variant (fromEnum c `rem` 4)
+genUnicode :: IsString a => Gen a
+genUnicode = fmap fromString string where
+    string = sized $ \n ->
+        do k <- choose (0,n)
+           sequence [ char | _ <- [1..k] ]
+    
+    excluding :: [a -> Bool] -> Gen a -> Gen a
+    excluding bad gen = loop
+      where
+        loop = do
+          x <- gen
+          if or (map ($ x) bad)
+            then loop
+            else return x
+    
+    reserved = [lowSurrogate, highSurrogate, noncharacter]
+    lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
+    highSurrogate c = c >= 0xD800 && c <= 0xDBFF
+    noncharacter c = masked == 0xFFFE || masked == 0xFFFF
+      where
+        masked = c .&. 0xFFFF 
+    
+    ascii = choose (0,0x7F)
+    plane0 = choose (0xF0, 0xFFFF)
+    plane1 = oneof [ choose (0x10000, 0x10FFF)
+                   , choose (0x11000, 0x11FFF)
+                   , choose (0x12000, 0x12FFF)
+                   , choose (0x13000, 0x13FFF)
+                   , choose (0x1D000, 0x1DFFF)
+                   , choose (0x1F000, 0x1FFFF)
+                   ]
+    plane2 = oneof [ choose (0x20000, 0x20FFF)
+                   , choose (0x21000, 0x21FFF)
+                   , choose (0x22000, 0x22FFF)
+                   , choose (0x23000, 0x23FFF)
+                   , choose (0x24000, 0x24FFF)
+                   , choose (0x25000, 0x25FFF)
+                   , choose (0x26000, 0x26FFF)
+                   , choose (0x27000, 0x27FFF)
+                   , choose (0x28000, 0x28FFF)
+                   , choose (0x29000, 0x29FFF)
+                   , choose (0x2A000, 0x2AFFF)
+                   , choose (0x2B000, 0x2BFFF)
+                   , choose (0x2F000, 0x2FFFF)
+                   ]
+    plane14 = choose (0xE0000, 0xE0FFF)
+    planes = [ascii, plane0, plane1, plane2, plane14]
+    
+    char = chr `fmap` excluding reserved (oneof planes)
 
+-- For tests that have O(n^2) running times or input sizes, resize
+-- their inputs to the square root of the originals.
+unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
+unsquare = forAll smallArbitrary
+
+smallArbitrary :: (Arbitrary a, Show a) => Gen a
+smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
+  where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
+
 instance Arbitrary T.Text where
-    arbitrary     = T.pack `fmap` arbitrary
-    coarbitrary s = coarbitrary (T.unpack s)
+    arbitrary = T.pack `fmap` arbitrary
 
 instance Arbitrary TL.Text where
-    arbitrary     = TL.pack `fmap` arbitrary
-    coarbitrary s = coarbitrary (TL.unpack s)
+    arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
 
 newtype NotEmpty a = NotEmpty { notEmpty :: a }
-    deriving (Eq, Ord, Show)
+    deriving (Eq, Ord)
 
+instance Show a => Show (NotEmpty a) where
+    show (NotEmpty a) = show a
+
 instance Functor NotEmpty where
     fmap f (NotEmpty a) = NotEmpty (f a)
 
 instance Arbitrary a => Arbitrary (NotEmpty [a]) where
     arbitrary   = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
-    coarbitrary = coarbitrary . notEmpty
 
 instance Arbitrary (NotEmpty T.Text) where
     arbitrary   = (fmap T.pack) `fmap` arbitrary
-    coarbitrary = coarbitrary . notEmpty
 
 instance Arbitrary (NotEmpty TL.Text) where
     arbitrary   = (fmap TL.pack) `fmap` arbitrary
-    coarbitrary = coarbitrary . notEmpty
 
 instance Arbitrary (NotEmpty B.ByteString) where
     arbitrary   = (fmap B.pack) `fmap` arbitrary
-    coarbitrary = coarbitrary . notEmpty
 
 data Small = S0  | S1  | S2  | S3  | S4  | S5  | S6  | S7
            | S8  | S9  | S10 | S11 | S12 | S13 | S14 | S15
@@ -120,7 +170,6 @@
 
 instance Arbitrary Small where
     arbitrary     = choose (minBound,maxBound)
-    coarbitrary c = variant (fromEnum c `rem` 4)
 
 integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
 integralRandomR  (a,b) g = case randomR (fromIntegral a :: Integer,
diff --git a/text.cabal b/text.cabal
--- a/text.cabal
+++ b/text.cabal
@@ -1,12 +1,12 @@
 name:           text
-version:        0.7.2.1
+version:        0.8.0.0
 synopsis:       An efficient packed Unicode text type
 description:    An efficient packed Unicode text type.
 license:        BSD3
 license-file:   LICENSE
-author:         Tom Harper <rtharper@aftereternity.co.uk>
+author:         Tom Harper <rtomharper@googlemail.com>
 maintainer:     Bryan O'Sullivan <bos@serpentine.com>
-                Tom Harper <rtharper@aftereternity.co.uk>
+                Tom Harper <rrtomharper@googlemail.com>
                 Duncan Coutts <duncan@haskell.org>
 copyright:      2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan
 category:       Data, Text
@@ -40,6 +40,7 @@
     Data.Text.Foreign
     Data.Text.IO
     Data.Text.Lazy
+    Data.Text.Lazy.Builder
     Data.Text.Lazy.Encoding
     Data.Text.Lazy.IO
   other-modules:
@@ -56,7 +57,6 @@
     Data.Text.Fusion.Size
     Data.Text.IO.Internal
     Data.Text.Internal
-    Data.Text.Lazy.Builder
     Data.Text.Lazy.Encoding.Fusion
     Data.Text.Lazy.Fusion
     Data.Text.Lazy.Internal
@@ -85,3 +85,4 @@
     ghc-options: -fwarn-tabs
   if flag(developer)
     ghc-options: -Werror
+    cpp-options: -DASSERTS
