Commits

Anonymous committed 183df05

Import of Tom Harper's Unicode 'text' package

Comments (0)

Files changed (11)

+{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE BangPatterns #-}
+
+module Text where
+
+import Prelude (Char,Bool,Int,Maybe,String,
+                Eq,(==),
+                Show,showsPrec,show,not,
+                Read,readsPrec,read,
+                (&&),(||),(+),(-),($),(<),(>),(<=),(>=),(.),(>>=),
+                return,otherwise,seq,fromIntegral)
+
+import Char (isSpace)
+import Control.Monad.ST(ST(..))
+import Data.Array.Base(unsafeNewArray_,unsafeWrite,unsafeAt)
+import Data.Array.ST(STUArray(..), runSTUArray)
+import qualified Data.ByteString as B
+import Data.ByteString(ByteString(..))
+import qualified Data.List as L
+import Data.Monoid(Monoid(..))
+import Data.Word(Word16(..))
+import System.IO hiding (readFile)
+
+import qualified Text.Fusion as S
+import Text.Fusion (Stream(..),Step(..),Encoding(..),
+                    stream,unstream,stream_bs,unstream_bs,restream,
+                    errorEmptyList)
+import Text.Internal(Text(..),empty)
+import qualified Prelude as P
+import Text.UnsafeChar(unsafeChr)
+import qualified Text.Utf16 as U16
+
+instance Eq Text where
+    t1 == t2 = (stream t1) `S.eq` (stream t2)
+
+instance Show Text where
+    showsPrec p ps r = showsPrec p (unpack ps) r
+
+instance Read Text where
+    readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
+
+instance Monoid Text where
+    mempty  = empty
+    mappend = append
+    mconcat = concat
+                  
+
+  
+-- -----------------------------------------------------------------------------
+-- * Conversion to/from 'Text'
+
+-- | /O(n)/ Convert a String into a Text.
+--
+-- This function is subject to array fusion, so calling other fusible 
+-- function(s) on a packed string will only cause one 'Text' to be written 
+-- out at the end of the pipeline, instead of one before and one after.
+pack :: String -> Text
+pack str = (unstream (stream_list str))
+    where
+      stream_list s0 = S.Stream next s0 (P.length s0) -- total guess
+          where
+            next []     = S.Done
+            next (x:xs) = S.Yield x xs
+{-# INLINE [1] pack #-}
+-- TODO: Has to do validation! -- No, it doesn't, the 
+
+-- | /O(n)/ Convert a Text into a String.
+-- Subject to array fusion.
+unpack :: Text -> String
+unpack txt = (unstream_list (stream txt))
+    where
+      unstream_list (S.Stream next s0 len) = unfold s0
+          where
+            unfold !s = case next s of
+                          S.Done       -> []
+                          S.Skip s'    -> seq s' $ unfold s'
+                          S.Yield x s' -> seq s' $ x : unfold s'
+{-# INLINE [1] unpack #-}
+
+-- | Convert a character into a Text.
+-- Subject to array fusion.
+singleton :: Char -> Text
+singleton c = unstream (Stream next (c:[]) 1)
+    where
+      {-# INLINE next #-}
+      next (c:cs) = Yield c cs
+      next []     = Done
+{-# INLINE [1] singleton #-}
+
+decode        :: Encoding -> ByteString -> Text
+decode enc bs = unstream (stream_bs enc bs)
+{-# INLINE decode #-}
+
+encode         :: Encoding -> Text -> ByteString
+encode enc txt = unstream_bs (restream enc (stream txt)) 
+{-# INLINE encode #-}
+
+-- -----------------------------------------------------------------------------
+-- * 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 array fusion.
+cons :: Char -> Text -> Text
+cons c t = unstream (S.cons c (stream t))
+{-# INLINE cons #-}
+
+-- | /O(n)/ Adds a character to the end of a 'Text'.  This copies the entire 
+-- array in the process.
+-- Subject to array fusion.
+snoc :: Text -> Char -> Text
+snoc t c = unstream (S.snoc (stream t) c)
+{-# INLINE snoc #-}
+
+-- | /O(n)/ Appends one Text to the other by copying both of them into a new 
+-- Text.  
+-- Subject to array fusion
+append :: Text -> Text -> Text
+append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (runSTUArray x) 0 len
+    where 
+      len = len1+len2
+      x = do
+        arr <- unsafeNewArray_ (0,len-1) :: ST s (STUArray s Int Word16)
+        copy arr1 off1 (len1+off1) arr 0
+        copy arr2 off2 (len2+off2) arr len1
+        return arr
+            where
+              copy arr i max arr' j
+                  | i >= max  = return () 
+                  | otherwise = do unsafeWrite arr' j (arr `unsafeAt` i)  
+                                   copy arr (i+1) max arr' (j+1)
+{-# INLINE append #-}
+
+{-# RULES
+"TEXT append -> fused" [~1] forall t1 t2. 
+    append t1 t2 = unstream (S.append (stream t1) (stream t2))
+"TEXT append -> unfused" [1] forall t1 t2.
+    unstream (S.append (stream t1) (stream t2)) = append t1 t2
+ #-}
+
+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
+-- Subject to array fusion.
+head :: Text -> Char
+head t = S.head (stream t)
+{-# INLINE head #-}
+
+-- | /O(n)/ Returns the last character of a Text, which must be non-empty.
+-- Subject to array fusion.
+last :: Text -> Char
+last (Text arr off len) 
+    | len <= 0                   = errorEmptyList "last"
+    | n < 0xDC00 || n > 0xDFFF = unsafeChr n
+    | otherwise                  = U16.chr2 n0 n
+    where
+      n  = unsafeAt arr (off+len-1)
+      n0 = unsafeAt arr (off+len-2)
+{-# INLINE [1] last #-}
+
+{-# RULES 
+"TEXT last -> fused" [~1] forall t.
+    last t = S.last (stream t)
+"TEXT last -> unfused" [1] forall t.
+    S.last (stream t) = last t
+  #-}
+
+
+-- | /O(1)/ Returns all characters after the head of a Text, which must
+-- be non-empty.
+-- Subject to array fusion. 
+tail :: Text -> Text
+tail (Text arr off len)
+    | len <= 0                   = errorEmptyList "tail"
+    | n >= 0xD800 && n <= 0xDBFF = Text arr (off+2) (len-2)
+    | otherwise                  = Text arr (off+1) (len-1)
+    where
+      n = unsafeAt arr off
+{-# INLINE [1] tail #-}
+
+
+
+-- | /O(1)/ Returns all but the last character of a Text, which 
+-- must be non-empty.
+-- Subject to array fusion.
+init :: Text -> Text 
+init (Text arr off len) | len <= 0                   = errorEmptyList "init"
+                        | n >= 0xDC00 && n <= 0xDFFF = Text arr off (len-2)
+                        | otherwise                  = Text arr off (len-1)
+    where
+      n = unsafeAt arr (off+len-1)
+{-# INLINE [1] init #-}
+
+{-# RULES
+"TEXT init -> fused" [~1] forall t.
+    init t = unstream (S.init (stream t))
+"TEXT init -> unfused" [1] forall t.
+    unstream (S.init (stream t)) = init t
+ #-}
+
+-- | /O(1)/ Tests whether a Text is empty or not.
+-- Subject to array fusion.
+null :: Text -> Bool
+null t = S.null (stream t)
+{-# INLINE null #-}
+
+-- | /O(n)/ Returns the number of characters in a text.
+-- Subject to array fusion.
+length :: Text -> Int
+length t = S.length (stream t)
+{-# INLINE length #-}
+
+-- -----------------------------------------------------------------------------
+-- * Transformations
+-- | /O(n)/ 'map' @f @xs is the Text obtained by applying @f@ to each
+-- element of @xs@.  
+-- Subject to array fusion.
+map :: (Char -> Char) -> Text -> Text
+map f t = unstream (S.map f (stream t))
+{-# INLINE [1] map #-}
+
+-- | /O(n)/ The 'intersperse' function takes a character and places it between 
+-- the characters of a Text.
+-- Subject to array fusion.
+intersperse     :: Char -> Text -> Text
+intersperse c t = unstream (S.intersperse c (stream t))
+{-# INLINE intersperse #-}
+
+-- | /O(n)/ The 'transpose' function transposes the rows and columns of its 
+-- Text argument.  Note that this function uses pack, unpack, and the 'List' 
+-- version of transpose and is thus not very efficient.
+transpose :: [Text] -> [Text]
+transpose ts = P.map pack (L.transpose (P.map unpack ts))
+
+-- -----------------------------------------------------------------------------
+-- * Reducing 'Text's (folds)
+
+-- | 'foldl', applied to a binary operator, a starting value (typically the 
+-- left-identity of the operator), and a Text, reduces the Text using the
+-- binary operator, from left to right.
+-- Subject to array fusion.
+foldl :: (b -> Char -> b) -> b -> Text -> b
+foldl f z t = S.foldl f z (stream t)
+{-# INLINE foldl #-}
+
+-- | A strict version of 'foldl'.
+-- Subject to array fusion.
+foldl' :: (b -> Char -> b) -> b -> Text -> b
+foldl' f z t = S.foldl' f z (stream t)
+{-# INLINE foldl' #-}
+
+-- | 'foldl1' is a variant of 'foldl' that has no starting value argument, 
+-- and thus must be applied to non-empty 'Text's.
+-- Subject to array fusion.
+foldl1 :: (Char -> Char -> Char) -> Text -> Char
+foldl1 f t = S.foldl1 f (stream t)
+{-# INLINE foldl1 #-}
+
+-- | A strict version of 'foldl1'.
+-- Subject to array fusion.
+foldl1' :: (Char -> Char -> Char) -> Text -> Char
+foldl1' f t = S.foldl1' f (stream t)
+{-# INLINE foldl1' #-}
+
+-- | 'foldr', applied to a binary operator, a starting value (typically the 
+-- right-identity of the operator), and a Text, reduces the Text using the
+-- binary operator, from right to left.
+-- Subject to array fusion.
+foldr :: (Char -> b -> b) -> b -> Text -> b
+foldr f z t = S.foldr f z (stream t)
+{-# INLINE foldr #-}
+
+-- | 'foldr1' is a variant of 'foldr' that has no starting value argument, 
+-- and thust must be applied to non-empty 'Text's.
+-- Subject to array fusion.
+foldr1 :: (Char -> Char -> Char) -> Text -> Char
+foldr1 f t = S.foldr1 f (stream t)
+{-# INLINE foldr1 #-}
+
+-- -----------------------------------------------------------------------------
+-- ** Special folds
+
+-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.
+concat :: [Text] -> Text
+concat ts = unstream (S.concat (L.map stream ts))
+{-# INLINE concat #-}
+
+-- | Map a function over a Text that results in a Text and concatenate the 
+-- results.  This function is subject to array fusion, and note that if in 
+-- 'concatMap' @f @xs, @f@ is defined in terms of fusible functions it will 
+-- also be fusible. 
+concatMap :: (Char -> Text) -> Text -> Text
+concatMap f t = unstream (S.concatMap (stream . f) (stream t))
+{-# INLINE concatMap #-}
+
+-- | 'any' @p @xs determines if any character in the 'Text' @xs@ satisifes the
+-- predicate @p@. Subject to array fusion.
+any :: (Char -> Bool) -> Text -> Bool
+any p t = S.any p (stream t)
+{-# INLINE any #-}
+
+-- | 'all' @p @xs determines if all characters in the 'Text' @xs@ satisify the
+-- predicate @p@. Subject to array fusion.
+all :: (Char -> Bool) -> Text -> Bool
+all p t = S.all p (stream t)
+{-# INLINE all #-}
+
+-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which must be 
+-- non-empty. Subject to array fusion.
+maximum :: Text -> Char
+maximum t = S.maximum (stream t)
+{-# INLINE maximum #-}
+
+-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which must be 
+-- non-empty. Subject to array fusion.
+minimum :: Text -> Char
+minimum t = S.minimum (stream t)
+{-# INLINE minimum #-}
+
+-- -----------------------------------------------------------------------------
+-- * Building 'Text's
+
+-- -----------------------------------------------------------------------------
+-- ** Generating and unfolding 'Text's
+
+-- /O(n)/, where @n@ is the length of the result. The unfoldr function
+-- is analogous to the List 'unfoldr'. unfoldr builds a Text
+-- from a seed value. The function takes the element and returns
+-- Nothing if it is done producing the Text or returns Just
+-- (a,b), in which case, a is the next Char in the string, and b is
+-- the seed value for further production.
+unfoldr     :: (a -> Maybe (Char,a)) -> a -> Text
+unfoldr f s = unstream (S.unfoldr f s)
+{-# INLINE unfoldr #-}
+
+-- O(n) Like unfoldr, unfoldrN builds a Text from a seed
+-- value. However, the length of the result should be limited by the
+-- first argument to unfoldrN. This function is more efficient than
+-- unfoldr when the maximum length of the result and correct,
+-- otherwise its complexity performance is similar to 'unfoldr'
+unfoldrN     :: Int -> (a -> Maybe (Char,a)) -> a -> Text
+unfoldrN n f s = unstream (S.unfoldrN n f s)
+{-# INLINE unfoldrN #-}
+
+-- -----------------------------------------------------------------------------
+-- * Substrings
+
+-- O(n) 'take' @n, applied to a Text, returns the prefix of the
+-- Text of length n, or the Text itself if n is greater than the
+-- length of the Text.
+take :: Int -> Text -> Text
+take n (Text arr off len) = Text arr off (loop off 0)
+    where
+      end = off+len
+      loop !i !count 
+           | i >= end || count >= n   = i - off
+           | c < 0xD800 || c > 0xDBFF = loop (i+1) (count+1) 
+           | otherwise                = loop (i+2) (count+1)
+           where
+             c = arr `unsafeAt` i
+{-# INLINE [1] take #-}
+
+{-# RULES 
+"TEXT take -> fused" [~1] forall n t.
+    take n t = unstream (S.take n (stream t))
+"TEXT take -> unfused" [1] forall n t.
+    unstream (S.take n (stream t)) = take n t
+  #-}
+
+-- /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.
+drop :: Int -> Text -> Text
+drop n (Text arr off len) = (Text arr newOff newLen)
+    where
+      (newOff, newLen) = loop off 0 len
+      end = off + len
+      loop !i !count !l
+          | i >= end || count >= n   = (i,l)
+          | c < 0xD800 || c > 0xDBFF = loop (i+1) (count+1) (l-1)
+          | otherwise                = loop (i+2) (count+1) (l-2)
+          where
+            c = arr `unsafeAt` i
+{-# INLINE [1] drop #-}
+
+{-# RULES 
+"TEXT drop -> fused" [~1] forall n t.
+    drop n t = unstream (S.drop n (stream t))
+"TEXT drop -> unfused" [1] forall n t.
+    unstream (S.drop n (stream t)) = drop n t
+  #-}
+
+-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the
+-- longest prefix (possibly empty) of elements that satisfy p.
+takeWhile :: (Char -> Bool) -> Text -> Text
+takeWhile p t = unstream (S.takeWhile p (stream t))
+
+-- | 'dropWhile' @p @xs returns the suffix remaining after 'takeWhile' @p @xs.
+dropWhile :: (Char -> Bool) -> Text -> Text
+dropWhile p t = unstream (S.dropWhile p (stream t))
+
+-- ----------------------------------------------------------------------------
+-- * Searching 
+
+-------------------------------------------------------------------------------
+-- ** Searching by equality
+
+-- | /O(n)/ 'elem' is the 'Text' membership predicate.
+elem :: Char -> Text -> Bool
+elem c t = S.elem c (stream t)
+{-# INLINE elem #-}
+
+-------------------------------------------------------------------------------
+-- ** Searching with a predicate
+
+-- | /O(n)/ The 'find' function takes a predicate and a 'Text',
+-- and returns the first element in matching the predicate, or 'Nothing'
+-- if there is no such element.
+find :: (Char -> Bool) -> Text -> Maybe Char
+find p t = S.find p (stream t)
+{-# INLINE find #-}
+
+-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
+-- returns a 'Text' containing those characters that satisfy the
+-- predicate.
+filter :: (Char -> Bool) -> Text -> Text
+filter p t = unstream (S.filter p (stream t))
+{-# INLINE filter #-}
+
+
+-------------------------------------------------------------------------------
+-- ** Indexing 'Text's
+
+-- | /O(1)/ 'Text' index (subscript) operator, starting from 0.
+index :: Text -> Int -> Char
+index t n = S.index (stream t) n
+{-# INLINE index #-}
+
+-- | The 'findIndex' function takes a predicate and a 'Text' and
+-- returns the index of the first element in the 'Text'
+-- satisfying the predicate.
+findIndex :: (Char -> Bool) -> Text -> Maybe Int
+findIndex p t = S.findIndex p (stream t)
+{-# INLINE findIndex #-}
+
+-- | /O(n)/ The 'elemIndex' function returns the index of the first
+-- element in the given 'Text' which is equal to the query element, or
+-- 'Nothing' if there is no such element.
+elemIndex :: Char -> Text -> Maybe Int
+elemIndex c t = S.elemIndex c (stream t)
+
+-------------------------------------------------------------------------------
+-- * Zipping
+
+-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
+-- given as the first argument, instead of a tupling function.
+zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
+
+-- File I/O 
+
+readFile :: Encoding -> FilePath -> IO Text
+readFile enc f = B.readFile f >>= return . unstream . stream_bs enc 
+{-# INLINE [1] readFile #-}
+
+words :: Text -> [Text]
+words (Text arr off len) = loop0 off off
+    where
+      loop0 start n 
+            | isSpace (unsafeChr c) = if start == n
+                                      then loop0 (start+1) (start+1) 
+                                      else (Text arr start (n-start)):loop0 (n+1) (n+1)
+            | n < (off+len) = loop0 start (n+1)
+            | otherwise = if start == n
+                          then [] 
+                          else [(Text arr start (n-start))]
+            where
+              c = arr `unsafeAt` n
+{-# INLINE words #-}
+{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE BangPatterns #-}
+
+module Text.Fusion where
+
+import Prelude hiding (map, tail, head, foldr, filter,concat)
+
+import Char
+import Control.Exception(assert)
+import Control.Monad(liftM2)
+import Control.Monad.ST(runST,ST(..))
+import Data.Array.Base
+import Data.Bits
+import qualified Data.ByteString as B
+import Data.ByteString.Internal(ByteString(..),mallocByteString,memcpy)
+import qualified Data.List as L
+import Data.Word(Word8(..),Word16(..),Word32(..))
+import Foreign.ForeignPtr(withForeignPtr,ForeignPtr(..))
+import Foreign.Storable(pokeByteOff)
+import GHC.Exts
+import System.IO.Unsafe(unsafePerformIO)
+
+import Text.Internal(Text(..),empty)
+import Text.UnsafeChar(unsafeChr,unsafeChr8,unsafeChr32)
+import qualified Text.Utf8 as U8
+import qualified Text.Utf16 as U16
+import qualified Text.Utf32 as U32
+
+default(Int)
+
+infixl 2 :!:
+data PairS a b = !a :!: !b
+
+data Switch = S1 | S2
+
+data EitherS a b = LeftS !a | RightS !b
+
+data Stream a = forall s. Stream (s -> Step s a) !s {-# UNPACK #-}!Int
+
+data Step s a = Done
+              | Skip !s
+              | Yield !a !s
+
+data Encoding = ASCII | Utf8 | Utf16BE | Utf16LE | Utf32BE | Utf32LE
+
+-- | /O(n)/ Convert a Text into a Stream Char.
+stream :: Text -> Stream Char
+stream (Text arr off len) = Stream next off len
+    where
+      end = off+len
+      {-# INLINE next #-}
+      next !i
+          | i >= end = Done
+          | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)
+          | otherwise = Yield (unsafeChr n) (i + 1)
+          where
+            n  = unsafeAt arr i
+            n2 = unsafeAt arr (i + 1)
+{-# INLINE [0] stream #-}
+
+-- | /O(n)/ Convert a Stream Char into a Text.
+unstream :: Stream Char -> Text
+unstream (Stream next0 s0 len) = x `seq` Text (fst x) 0 (snd x)
+    where
+      x :: ((UArray Int Word16),Int)
+      x = runST ((unsafeNewArray_ (0,len+1) :: ST s (STUArray s Int Word16)) 
+                 >>= (\arr -> loop arr 0 (len+1) s0))
+      loop arr !i !max !s
+          | i + 1 > max = do arr' <- unsafeNewArray_ (0,max*2)
+                             case next0 s of
+                               Done -> liftM2 (,) (unsafeFreezeSTUArray arr) (return i)
+                               _    -> copy arr arr' >> loop arr' i (max*2) s
+          | otherwise = case next0 s of
+               Done       -> liftM2 (,) (unsafeFreezeSTUArray arr) (return i)
+               Skip s'    -> loop arr i max s'
+               Yield x s'
+                   | n < 0x10000 -> do
+                        unsafeWrite arr i (fromIntegral n :: Word16)
+                        loop arr (i+1) max s'
+                   | otherwise   -> do
+                        unsafeWrite arr i       l
+                        unsafeWrite arr (i + 1) r
+                        loop arr (i+2) max s' 
+                   where
+                     n :: Int
+                     n = ord x
+                     m :: Int
+                     m = n - 0x10000
+                     l :: Word16
+                     l = fromIntegral $ (shiftR m 10) + (0xD800 :: Int)
+                     r :: Word16
+                     r = fromIntegral $ (m .&. (0x3FF :: Int)) + (0xDC00 :: Int)
+{-# INLINE [0] unstream #-}
+
+
+copy src dest = (do 
+                   (_,max) <- getBounds src
+                   copy_loop 0 max)
+    where
+      copy_loop !i !max 
+          | i > max    = return ()
+          | otherwise = do v <- unsafeRead src i 
+                           unsafeWrite dest i v
+                           copy_loop (i+1) max
+
+-- | /O(n)/ Determines if two streams are equal.
+eq :: Ord a => Stream a -> Stream a -> Bool
+eq (Stream next1 s1 _) (Stream next2 s2 _) = compare (next1 s1) (next2 s2)
+    where
+      compare Done Done = True
+      compare Done _    = False
+      compare _    Done = False
+      compare (Skip s1')     (Skip s2')     = compare (next1 s1') (next2 s2')
+      compare (Skip s1')     x2             = compare (next1 s1') x2
+      compare x1             (Skip s2')     = compare x1          (next2 s2')
+      compare (Yield x1 s1') (Yield x2 s2') = x1 == x2 && 
+                                              compare (next1 s1') (next2 s2')
+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
+
+
+-- | /O(n) Convert a ByteString into a Stream Char, using the specified encoding standard.
+stream_bs :: Encoding -> ByteString -> Stream Char
+stream_bs ASCII bs = Stream next 0 (B.length bs)
+    where
+      {-# INLINE next #-}
+      next i 
+          | i >= l    = Done
+          | otherwise = Yield (unsafeChr8 x1) (i+1)
+          where
+            l  = B.length bs
+            x1 = B.index bs i 
+stream_bs Utf8 bs = Stream next 0 (B.length bs)
+    where
+      {-# INLINE next #-}
+      next i
+          | i >= l = Done
+          | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
+          | 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 = error "bsStream: bad UTF-8 stream"
+          where
+            l  = B.length bs
+            x1 = index i
+            x2 = index (i + 1)
+            x3 = index (i + 2)
+            x4 = index (i + 3)
+            index = B.index bs           
+stream_bs Utf16LE bs = Stream next 0 (B.length bs)
+    where
+      {-# INLINE next #-}
+      next i 
+          | i >= l                         = Done
+          | i+1 < l && U16.validate1 x1    = Yield (unsafeChr x1) (i+2)
+          | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
+          | otherwise = error $ "bsStream: bad UTF-16LE stream"
+          where
+            x1    :: Word16
+            x1    = (shiftL (index (i + 1)) 8) + (index i)
+            x2    :: Word16
+            x2    = (shiftL (index (i + 3)) 8) + (index (i + 2))
+            l     = B.length bs   
+            index = fromIntegral . B.index bs :: Int -> Word16
+stream_bs Utf16BE bs = Stream next 0 (B.length bs)
+    where
+      {-# INLINE next #-}
+      next i 
+          | i >= l                         = Done
+          | i+1 < l && U16.validate1 x1    = Yield (unsafeChr x1) (i+2)
+          | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
+          | otherwise = error $ "bsStream: bad UTF16-BE stream "
+          where
+            x1    :: Word16
+            x1    = (shiftL (index i) 8) + (index (i + 1))
+            x2    :: Word16
+            x2    = (shiftL (index (i + 2)) 8) + (index (i + 3))
+            l     = B.length bs
+            index = fromIntegral . B.index bs
+stream_bs Utf32BE bs = Stream next 0 (B.length bs)
+    where
+      {-# INLINE next #-}
+      next i 
+          | i >= l                    = Done
+          | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
+          | otherwise                 = error "bsStream: bad UTF-32BE stream"
+          where
+            l     = B.length bs
+            x     = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
+            x1    = index i
+            x2    = index (i+1)
+            x3    = index (i+2)
+            x4    = index (i+3)
+            index = fromIntegral . B.index bs :: Int -> Word32
+stream_bs Utf32LE bs = Stream next 0 (B.length bs)
+    where
+      {-# INLINE next #-}
+      next i 
+          | i >= l                    = Done
+          | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
+          | otherwise                 = error "bsStream: bad UTF-32LE stream"
+          where
+            l     = B.length bs
+            x     = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
+            x1    = index i
+            x2    = index $ i+1
+            x3    = index $ i+2
+            x4    = index $ i+3
+            index = fromIntegral . B.index bs :: Int -> Word32
+{-# INLINE [0] stream_bs #-}
+
+-- | /O(n)/ Convert a Stream Char into a Stream Word8 using the specified encoding standard.
+restream :: Encoding -> Stream Char -> Stream Word8
+restream ASCII (Stream next0 s0 len) =  Stream next s0 (len*2)
+    where
+      next !s = case next0 s of
+                  Done -> Done
+                  Skip s' -> Skip s'
+                  Yield x xs -> Yield x' xs
+                      where x' = fromIntegral (ord x) :: Word8
+restream Utf8 (Stream next0 s0 len) = 
+    Stream next ((Just s0) :!: Nothing :!: Nothing :!: Nothing) (len*2)
+    where
+      {-# INLINE next #-}
+      next ((Just s) :!: Nothing :!: Nothing :!: Nothing) = case next0 s of 
+                  Done              -> Done
+                  Skip s'           -> Skip ((Just s') :!: Nothing :!: Nothing :!: Nothing)
+                  Yield x xs 
+                      | n <= 0x7F   -> Yield c         ((Just xs) :!: Nothing   :!: Nothing   :!: Nothing)
+                      | n <= 0x07FF -> Yield (fst c2)  ((Just xs) :!: (Just $ snd c2)  :!: Nothing   :!: Nothing)
+                      | n <= 0xFFFF -> Yield (fst3 c3) ((Just xs) :!: (Just $ snd3 c3) :!: (Just $ trd3 c3) :!: Nothing)
+                      | otherwise   -> Yield (fst4 c4) ((Just xs) :!: (Just $ snd4 c4) :!: (Just $ trd4 c4) :!: (Just $ fth4 c4))
+                      where
+                        n  = ord x
+                        c  = fromIntegral n
+                        c2 = U8.ord2 x
+                        c3 = U8.ord3 x
+                        c4 = U8.ord4 x          
+      next ((Just s) :!: (Just x2) :!: Nothing :!: Nothing) = Yield x2 ((Just s) :!: Nothing :!: Nothing :!: Nothing)
+      next ((Just s) :!: (Just x2) :!: x3 :!: Nothing)      = Yield x2 ((Just s) :!: x3 :!: Nothing :!: Nothing)
+      next ((Just s) :!: (Just x2) :!: x3 :!: x4)           = Yield x2 ((Just s) :!: x3 :!: x4 :!: Nothing)
+restream Utf16BE (Stream next0 s0 len) =
+    Stream next (Just s0 :!: Nothing :!: Nothing :!: Nothing) (len*2)
+    where
+      {-# INLINE next #-}
+      next (Just s :!: Nothing :!: Nothing :!: Nothing) = case next0 s of 
+          Done -> Done
+          Skip s' -> Skip (Just s' :!: Nothing :!: Nothing :!: Nothing)
+          Yield x xs
+              | n < 0x10000 -> Yield (fromIntegral $ shiftR n 8) (Just xs :!: Just (fromIntegral n) :!: Nothing :!: Nothing)
+              | otherwise   -> Yield c1                          (Just xs :!: Just c2 :!: Just c3 :!: Just c4)
+              where
+                n  = ord x
+                n1 = n - 0x10000 
+                c1 = fromIntegral (shiftR n1 18 + 0xD8)
+                c2 = fromIntegral (shiftR n1 10)       
+                n2 = n1 .&. 0x3FF
+                c3 = fromIntegral (shiftR n2 8 + 0xDC) 
+                c4 = fromIntegral n2     
+      next ((Just s) :!: (Just x2) :!: Nothing :!: Nothing) = Yield x2 ((Just s) :!: Nothing :!: Nothing :!: Nothing)
+      next ((Just s) :!: (Just x2) :!: x3 :!: Nothing)      = Yield x2 ((Just s) :!: x3 :!: Nothing :!: Nothing)
+      next ((Just s) :!: (Just x2) :!: x3 :!: x4)           = Yield x2 ((Just s) :!: x3 :!: x4 :!: Nothing)
+restream Utf16LE (Stream next0 s0 len) =
+    Stream next (Just s0 :!: Nothing :!: Nothing :!: Nothing) (len*2)
+    where
+      {-# INLINE next #-}
+      next (Just s :!: Nothing :!: Nothing :!: Nothing) = case next0 s of 
+          Done -> Done
+          Skip s' -> Skip (Just s' :!: Nothing :!: Nothing :!: Nothing)
+          Yield x xs
+              | n < 0x10000 -> Yield (fromIntegral n) (Just xs :!: Just (fromIntegral $ shiftR n 8) :!: Nothing :!: Nothing)
+              | otherwise   -> Yield c1                          (Just xs :!: Just c2 :!: Just c3 :!: Just c4)
+              where
+                n  = ord x
+                n1 = n - 0x10000 
+                c2 = fromIntegral (shiftR n1 18 + 0xD8)
+                c1 = fromIntegral (shiftR n1 10)       
+                n2 = n1 .&. 0x3FF
+                c4 = fromIntegral (shiftR n2 8 + 0xDC) 
+                c3 = fromIntegral n2     
+      next ((Just s) :!: (Just x2) :!: Nothing :!: Nothing) = Yield x2 ((Just s) :!: Nothing :!: Nothing :!: Nothing)
+      next ((Just s) :!: (Just x2) :!: x3 :!: Nothing)      = Yield x2 ((Just s) :!: x3 :!: Nothing :!: Nothing)
+      next ((Just s) :!: (Just x2) :!: x3 :!: x4)           = Yield x2 ((Just s) :!: x3 :!: x4 :!: Nothing)
+restream Utf32BE (Stream next0 s0 len) = 
+    Stream next (Just s0 :!: Nothing :!: Nothing :!: Nothing) (len*2)
+    where
+    {-# INLINE next #-}
+    next (Just s :!: Nothing :!: Nothing :!: Nothing) = case next0 s of 
+        Done       -> Done
+        Skip s'    -> Skip (Just s' :!: Nothing :!: Nothing :!: Nothing)
+        Yield x xs -> Yield c1 (Just xs :!: Just c2 :!: Just c3 :!: Just c4)
+          where
+            n  = ord x
+            c1 = fromIntegral $ shiftR n 24
+            c2 = fromIntegral $ shiftR n 16
+            c3 = fromIntegral $ shiftR n 8
+            c4 = fromIntegral n
+    next ((Just s) :!: (Just x2) :!: Nothing :!: Nothing) = Yield x2 ((Just s) :!: Nothing :!: Nothing :!: Nothing)
+    next ((Just s) :!: (Just x2) :!: x3 :!: Nothing)      = Yield x2 ((Just s) :!: x3 :!: Nothing :!: Nothing)
+    next ((Just s) :!: (Just x2) :!: x3 :!: x4)           = Yield x2 ((Just s) :!: x3 :!: x4 :!: Nothing)
+restream Utf32LE (Stream next0 s0 len) = 
+    Stream next (Just s0 :!: Nothing :!: Nothing :!: Nothing) (len*2)
+    where
+    {-# INLINE next #-}
+    next (Just s :!: Nothing :!: Nothing :!: Nothing) = case next0 s of 
+        Done       -> Done
+        Skip s'    -> Skip (Just s' :!: Nothing :!: Nothing :!: Nothing)
+        Yield x xs -> Yield c1 (Just xs :!: Just c2 :!: Just c3 :!: Just c4)
+          where
+            n  = ord x
+            c4 = fromIntegral $ shiftR n 24
+            c3 = fromIntegral $ shiftR n 16
+            c2 = fromIntegral $ shiftR n 8
+            c1 = fromIntegral n
+    next ((Just s) :!: (Just x2) :!: Nothing :!: Nothing) = Yield x2 ((Just s) :!: Nothing :!: Nothing :!: Nothing)
+    next ((Just s) :!: (Just x2) :!: x3 :!: Nothing)      = Yield x2 ((Just s) :!: x3 :!: Nothing :!: Nothing)
+    next ((Just s) :!: (Just x2) :!: x3 :!: x4)           = Yield x2 ((Just s) :!: x3 :!: x4 :!: Nothing)
+{-# INLINE restream #-}
+      
+
+fst3 (x1,_,_)   = x1
+snd3 (_,x2,_)   = x2
+trd3 (_,_,x3)   = x3
+fst4 (x1,_,_,_) = x1   
+snd4 (_,x2,_,_) = x2
+trd4 (_,_,x3,_) = x3
+fth4 (_,_,_,x4) = x4 
+
+-- | /O(n)/ Convert a Stream Word8 to a ByteString
+unstream_bs :: Stream Word8 -> ByteString
+unstream_bs (Stream next s0 len) = unsafePerformIO $ do
+    fp0 <- mallocByteString len
+    loop fp0 len 0 s0
+    where
+      loop !fp !n !off !s = case next s of
+          Done -> trimUp fp n off
+          Skip s' -> loop fp n off s'
+          Yield x s'
+              | n == off -> realloc fp n off s' x
+              | otherwise -> do
+            withForeignPtr fp $ \p -> pokeByteOff p off x
+            loop fp n (off+1) s'
+      {-# NOINLINE realloc #-}
+      realloc fp n off s x = do
+        let n' = n+n
+        fp' <- copy0 fp n n'
+        withForeignPtr fp' $ \p -> pokeByteOff p off x
+        loop fp' n' (off+1) s
+      {-# 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
+          dest <- mallocByteString destLen
+          withForeignPtr src  $ \src'  ->
+              withForeignPtr dest $ \dest' ->
+                  memcpy dest' src' (fromIntegral destLen)
+          return dest
+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
+
+-- ----------------------------------------------------------------------------
+-- * Basic stream functions
+
+-- | /O(n)/ Adds a character to the front of a Stream Char. 
+cons :: Char -> Stream Char -> Stream Char
+cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2)
+    where
+      {-# INLINE next #-}
+      next (S2 :!: s) = Yield w (S1 :!: s)
+      next (S1 :!: s) = case next0 s of 
+                          Done -> Done
+                          Skip s' -> Skip (S1 :!: s')
+                          Yield x s' -> Yield x (S1 :!: s')
+{-# INLINE [0] cons #-}
+
+-- | /O(n)/ Adds a character to the end of a stream.
+snoc :: Stream Char -> Char -> Stream Char
+snoc (Stream next0 xs0 len) w = Stream next (Just xs0) (len+2)
+  where
+    {-# INLINE next #-}
+    next (Just xs) = case next0 xs of
+      Done        -> Yield w Nothing
+      Skip xs'    -> Skip    (Just xs')
+      Yield x xs' -> Yield x (Just xs')
+    next Nothing = Done
+{-# INLINE [0] snoc #-}
+
+-- | /O(n)/ Appends one Stream to the other.
+append :: Stream Char -> Stream Char -> Stream Char
+append (Stream next0 s01 len1) (Stream next1 s02 len2) = 
+    Stream next (Left s01) (len1 + len2)
+    where
+      {-# INLINE next #-}
+      next (Left s1) = case next0 s1 of 
+                         Done        -> Skip    (Right s02)
+                         Skip s1'    -> Skip    (Left s1')
+                         Yield x s1' -> Yield x (Left s1')
+      next (Right s2) = case next1 s2 of
+                          Done        -> Done
+                          Skip s2'    -> Skip    (Right s2')
+                          Yield x s2' -> Yield x (Right s2')
+{-# INLINE [0] append #-}
+
+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
+-- Subject to array fusion.
+head :: Stream Char -> Char
+head (Stream next s0 len) = loop_head s0
+    where 
+      loop_head !s = case next s of 
+                      Yield x _ -> x
+                      Skip s' -> loop_head s'
+                      Done -> error "head: Empty list"
+{-# INLINE [0] head #-}
+
+-- | /O(n)/ Returns the last character of a Stream Char, which must be non-empty.
+last :: Stream Char -> Char
+last (Stream next s0 len) = loop0_last s0
+    where
+      loop0_last !s = case next s of
+                        Done       -> error "last: Empty list"
+                        Skip s'    -> seq s' $ loop0_last  s'
+                        Yield x s' -> seq s' $ loop_last x s'
+      loop_last !x !s = case next s of
+                         Done        -> x
+                         Skip s'     -> seq s' $ loop_last x  s'
+                         Yield x' s' -> seq s' $ loop_last x' s'
+{-# INLINE[0] last #-}
+
+-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
+-- be non-empty.
+tail :: Stream Char -> Stream Char
+tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1)
+    where
+      {-# INLINE next #-}
+      next (False :!: s) = case next0 s of
+                          Done -> error "tail"
+                          Skip s' -> Skip (False :!: s')
+                          Yield _ s' -> Skip (True :!: s') 
+      next (True :!: s) = case next0 s of
+                          Done -> Done
+                          Skip s' -> Skip (True :!: s')
+                          Yield x s' -> Yield x (True :!: s')
+{-# INLINE [0] tail #-}
+
+
+-- | /O(1)/ Returns all but the last character of a Stream Char, which 
+-- must be non-empty.
+init :: Stream Char -> Stream Char
+init (Stream next0 s0 len) = Stream next (Nothing :!: s0) (len-1)
+    where
+      {-# INLINE next #-}
+      next (Nothing :!: s) = case next0 s of
+                               Done       -> errorEmptyList "init"
+                               Skip s'    -> seq s' $ Skip (Nothing :!: s')
+                               Yield x s' -> seq s' $ Skip (Just x  :!: s')
+      next (Just x :!: s)  = case next0 s of
+                               Done        -> Done
+                               Skip s'     -> seq s' $ Skip    (Just x  :!: s')
+                               Yield x' s' -> seq s' $ Yield x (Just x' :!: s')
+{-# INLINE [0] init #-}
+
+-- | /O(1)/ Tests whether a Stream Char is empty or not.
+null :: Stream Char -> Bool
+null (Stream next s0 len) = loop_null s0
+    where
+      loop_null !s = case next s of
+                       Done      -> True
+                       Yield _ _ -> False
+                       Skip s'   -> loop_null s'
+{-# INLINE[0] null #-}
+
+-- | /O(n)/ Returns the number of characters in a text.
+length :: Stream Char -> Int
+length (Stream next s0 len) = loop_length 0# s0
+    where
+
+      loop_length z# !s  = case next s of 
+                            Done       -> (I# z#)
+                            Skip    s' -> loop_length z# s' 
+                            Yield _ s' -> loop_length (z# +# 1#) s' 
+{-# INLINE[0] length #-}
+
+-- ----------------------------------------------------------------------------
+-- * Stream transformations
+
+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of 
+-- @xs@. 
+map :: (Char -> Char) -> Stream Char -> Stream Char
+map f (Stream next0 s0 len) = Stream next s0 len
+    where
+      {-# INLINE next #-}
+      next !s = case next0 s of 
+                  Done       -> Done
+                  Skip s'    -> Skip s'
+                  Yield x s' -> Yield (f x) s'          
+{-# INLINE [0] map #-}
+
+{-# 
+  RULES "STREAM map/map fusion" forall f g s.
+     map f (map g s) = map (\x -> f (g x)) s
+ #-}
+
+-- | /O(n)/ The 'intersperse' function takes a character and places it between each of
+-- the characters of a Stream.
+intersperse :: Char -> Stream Char -> Stream Char
+intersperse c (Stream next0 s0 len) = Stream next (s0 :!: Nothing :!: S1) len
+    where
+      {-# INLINE next #-}
+      next (s :!: Nothing :!: S1) = case next0 s of
+        Done       -> Done
+        Skip s'    -> Skip (s' :!: Nothing :!: S1)
+        Yield x s' -> Skip (s' :!: Just x :!: S1)
+      next (s :!: Just x :!: S1)  = Yield x (s :!: Nothing :!: S2)
+      next (s :!: Nothing :!: S2) = case next0 s of
+        Done       -> Done
+        Skip s'    -> Skip    (s' :!: Nothing :!: S2)
+        Yield x s' -> Yield c (s' :!: Just x :!: S1)
+
+-- ----------------------------------------------------------------------------
+-- * Reducing Streams (folds)
+
+-- | foldl, applied to a binary operator, a starting value (typically the 
+-- left-identity of the operator), and a Stream, reduces the Stream using the
+-- binary operator, from left to right.
+foldl :: (b -> Char -> b) -> b -> Stream Char -> b
+foldl f z0 (Stream next s0 len) = loop_foldl z0 s0
+    where
+      loop_foldl z !s = case next s of
+                          Done -> z
+                          Skip s' -> loop_foldl z s'
+                          Yield x s' -> loop_foldl (f z x) s'
+{-# INLINE [0] foldl #-}
+
+-- | A strict version of foldl.
+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
+foldl' f z0 (Stream next s0 len) = loop_foldl' z0 s0
+    where
+      loop_foldl' !z !s = case next s of
+                            Done -> z
+                            Skip s' -> loop_foldl' z s'
+                            Yield x s' -> loop_foldl' (f z x) s'
+{-# INLINE [0] foldl' #-}
+
+-- | foldl1 is a variant of foldl that has no starting value argument, 
+-- and thus must be applied to non-empty Streams.
+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
+foldl1 f (Stream next s0 len) = loop0_foldl1 s0
+    where
+      loop0_foldl1 !s = case next s of
+                          Skip s' -> loop0_foldl1 s'
+                          Yield x s' -> loop_foldl1 x s'
+                          Done -> errorEmptyList "foldl1"
+      loop_foldl1 z !s = case next s of
+                           Done -> z
+                           Skip s' -> loop_foldl1 z s'
+                           Yield x s' -> loop_foldl1 (f z x) s'
+{-# INLINE [0] foldl1 #-}
+
+-- | A strict version of foldl1.
+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
+foldl1' f (Stream next s0 len) = loop0_foldl1' s0
+    where
+      loop0_foldl1' !s = case next s of
+                           Skip s' -> loop0_foldl1' s'
+                           Yield x s' -> loop_foldl1' x s'
+                           Done -> errorEmptyList "foldl1"
+      loop_foldl1' !z !s = case next s of
+                             Done -> z
+                             Skip s' -> loop_foldl1' z s'
+                             Yield x s' -> loop_foldl1' (f z x) s'
+{-# INLINE [0] foldl1' #-}
+
+-- | 'foldr', applied to a binary operator, a starting value (typically the 
+-- right-identity of the operator), and a stream, reduces the stream using the
+-- binary operator, from right to left.
+foldr :: (Char -> b -> b) -> b -> Stream Char -> b
+foldr f z (Stream next s0 len) = loop_foldr s0
+    where
+      loop_foldr !s = case next s of
+                        Done -> z
+                        Skip s' -> loop_foldr s'
+                        Yield x s' -> f x (loop_foldr s')
+{-# INLINE [0] foldr #-}
+
+-- | foldr1 is a variant of 'foldr' that has no starting value argument, 
+-- and thust must be applied to non-empty streams.
+-- Subject to array fusion.
+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
+foldr1 f (Stream next s0 len) = loop0_foldr1 s0
+  where
+    loop0_foldr1 !s = case next s of
+      Done       -> error "foldr1"
+      Skip    s' -> loop0_foldr1  s'
+      Yield x s' -> loop_foldr1 x s'
+
+    loop_foldr1 x !s = case next s of
+      Done        -> x
+      Skip     s' -> loop_foldr1 x s'
+      Yield x' s' -> f x (loop_foldr1 x' s')
+{-# INLINE [0] foldr1 #-}
+    
+-- ----------------------------------------------------------------------------
+-- ** Special folds
+
+-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
+concat :: [Stream Char] -> Stream Char
+concat = L.foldr append (Stream next Done 0)
+    where
+      next Done = Done
+
+-- | Map a function over a stream that results in a steram and concatenate the 
+-- results.
+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
+concatMap f = foldr (append . f) (stream empty)
+
+-- | /O(n)/ any @p @xs determines if any character in the stream
+-- @xs@ satisifes the predicate @p@.
+any :: (Char -> Bool) -> Stream Char -> Bool
+any p (Stream next0 s0 len) = loop_any s0
+    where
+      loop_any !s = case next0 s of
+                      Done                   -> False
+                      Skip s'                -> seq s' $ loop_any s'
+                      Yield x s' | p x       -> True
+                                 | otherwise -> seq s' $ loop_any s'
+
+-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
+-- @xs@ satisify the predicate @p@.
+all :: (Char -> Bool) -> Stream Char -> Bool
+all p (Stream next0 s0 len) = loop_all s0
+    where
+      loop_all !s = case next0 s of 
+                      Done                   -> True
+                      Skip s'                -> seq s' $ loop_all s'
+                      Yield x s' | p x       -> seq s' $ loop_all s'
+                                 | otherwise -> False
+
+-- | /O(n)/ maximum returns the maximum value from a stream, which must be 
+-- non-empty. 
+maximum :: Stream Char -> Char
+maximum (Stream next0 s0 len) = loop0_maximum s0
+    where
+      loop0_maximum !s   = case next0 s of
+                             Done       -> errorEmptyList "maximum"
+                             Skip s'    -> seq s' $ loop0_maximum s'
+                             Yield x s' -> seq s' $ loop_maximum x s'
+      loop_maximum !z !s = case next0 s of
+                             Done            -> z
+                             Skip s'         -> seq s' $ loop_maximum z s'
+                             Yield x s'
+                                 | x > z     -> seq s' $ loop_maximum x s'
+                                 | otherwise -> seq s' $ loop_maximum z s'
+                             
+-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be 
+-- non-empty.
+minimum :: Stream Char -> Char
+minimum (Stream next0 s0 len) = loop0_minimum s0
+    where
+      loop0_minimum !s   = case next0 s of
+                             Done       -> errorEmptyList "minimum"
+                             Skip s'    -> seq s' $ loop0_minimum s'
+                             Yield x s' -> seq s' $ loop_minimum x s'
+      loop_minimum !z !s = case next0 s of
+                             Done            -> z
+                             Skip s'         -> seq s' $ loop_minimum z s'
+                             Yield x s'
+                                 | x < z     -> seq s' $ loop_minimum x s'
+                                 | otherwise -> seq s' $ loop_minimum z s'
+
+
+                      
+                  
+-- -----------------------------------------------------------------------------
+-- * Building streams
+
+-- -----------------------------------------------------------------------------
+-- ** Generating and unfolding streams
+
+-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
+-- is analogous to the List 'unfoldr'. unfoldr builds a stream
+-- from a seed value. The function takes the element and returns
+-- Nothing if it is done producing the stream or returns Just
+-- (a,b), in which case, a is the next Char in the string, and b is
+-- the seed value for further production.
+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
+unfoldr f s0 = Stream next s0 1
+    where
+      {-# INLINE next #-}
+      next !s = case f s of
+                 Nothing      -> Done
+                 Just (w, s') -> Yield w s'
+{-# INLINE [0] unfoldr #-}
+
+-- | O(n) Like unfoldr, unfoldrN builds a stream from a seed
+-- value. However, the length of the result should be limited by the
+-- first argument to unfoldrN. This function is more efficient than
+-- unfoldr when the maximum length of the result and correct,
+-- otherwise its complexity performance is similar to 'unfoldr'
+unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char 
+unfoldrN n f s0 = Stream next (0 :!: s0) (n*2) 
+    where
+      {-# INLINE next #-}
+      next (z :!: s) = case f s of
+          Nothing                  -> Done
+          Just (w, s') | z >= n    -> Done
+                       | otherwise -> Yield w ((z + 1) :!: s')
+-------------------------------------------------------------------------------
+--  * Substreams
+
+-- | /O(n)/ take n, applied to a stream, returns the prefix of the
+-- stream of length @n@, or the stream itself if @n@ is greater than the
+-- length of the stream.
+take :: Int -> Stream Char -> Stream Char
+take n0 (Stream next0 s0 len) = Stream next (n0 :!: s0) len
+    where
+      {-# INLINE next #-}
+      next (n :!: s) | n <= 0    = Done
+                     | otherwise = case next0 s of
+                                     Done -> Done
+                                     Skip s' -> Skip (n :!: s')
+                                     Yield x s' -> Yield x ((n-1) :!: s')
+{-# 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.
+drop :: Int -> Stream Char -> Stream Char
+drop n0 (Stream next0 s0 len) = Stream next (Just ((max 0 n0)) :!: s0) (len - n0)
+  where
+    {-# INLINE next #-}
+    next (Just !n :!: s)
+      | n == 0    = Skip (Nothing :!: s)
+      | otherwise = case next0 s of
+          Done       -> Done
+          Skip    s' -> Skip (Just n    :!: s')
+          Yield _ s' -> Skip (Just (n-1) :!: s')
+    next (Nothing :!: s) = case next0 s of
+      Done       -> Done
+      Skip    s' -> Skip    (Nothing :!: s')
+      Yield x s' -> Yield x (Nothing :!: s')
+{-# INLINE [0] drop #-}
+
+-- | takeWhile, applied to a predicate @p@ and a stream, returns the
+-- longest prefix (possibly empty) of elements that satisfy p.
+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
+takeWhile p (Stream next0 s0 len) = Stream next s0 len
+    where
+      {-# INLINE next #-}
+      next !s = case next0 s of
+                  Done    -> Done
+                  Skip s' -> Skip s'
+                  Yield x s' | p x       -> Yield x s'
+                             | otherwise -> Done
+{-# INLINE [0] takeWhile #-}
+
+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
+dropWhile p (Stream next0 s0 len) = Stream next (S1 :!: s0) len
+    where
+    {-# INLINE next #-}
+    next (S1 :!: s)  = case next0 s of
+      Done                   -> Done
+      Skip    s'             -> Skip    (S1 :!: s')
+      Yield x s' | p x       -> Skip    (S1 :!: s')
+                 | otherwise -> Yield x (S2 :!: s')
+    next (S2 :!: s) = case next0 s of
+      Done       -> Done
+      Skip    s' -> Skip    (S2 :!: s')
+      Yield x s' -> Yield x (S2 :!: s')
+{-# INLINE [0] dropWhile #-}
+
+-- ----------------------------------------------------------------------------
+-- * Searching 
+
+-------------------------------------------------------------------------------
+-- ** Searching by equality
+
+-- | /O(n)/ elem is the stream membership predicate.
+elem :: Char -> Stream Char -> Bool
+elem w (Stream next s0 len) = loop_elem s0
+    where
+      loop_elem !s = case next s of
+                       Done -> False
+                       Skip s' -> loop_elem s'
+                       Yield x s' | x == w -> True
+                                  | otherwise -> loop_elem s'
+{-# INLINE [0] elem #-}
+
+-------------------------------------------------------------------------------
+-- ** Searching with a predicate
+
+-- | /O(n)/ The 'find' function takes a predicate and a stream,
+-- and returns the first element in matching the predicate, or 'Nothing'
+-- if there is no such element.
+
+find :: (Char -> Bool) -> Stream Char -> Maybe Char
+find p (Stream next s0 len) = loop_find s0
+    where
+      loop_find !s = case next s of 
+                       Done -> Nothing
+                       Skip s' -> loop_find s'
+                       Yield x s' | p x -> Just x
+                                  | otherwise -> loop_find s'
+{-# INLINE [0] find #-}
+
+-- | /O(n)/ 'filter', applied to a predicate and a stream,
+-- returns a stream containing those characters that satisfy the
+-- predicate.
+filter :: (Char -> Bool) -> Stream Char -> Stream Char
+filter p (Stream next0 s0 len) = Stream next s0 len
+  where
+    {-# INLINE next #-}
+    next !s = case next0 s of
+                Done                   -> Done
+                Skip    s'             -> Skip    s'
+                Yield x s' | p x       -> Yield x s'
+                           | otherwise -> Skip    s'
+{-# INLINE [0] filter #-}
+
+{-# RULES
+  "Stream filter/filter fusion" forall p q s.
+  filter p (filter q s) = filter (\x -> q x && p x) s
+  #-}
+
+-------------------------------------------------------------------------------
+-- ** Indexing streams
+
+-- | /O(1)/ stream index (subscript) operator, starting from 0.
+index :: Stream Char -> Int -> Char
+index (Stream next s0 len) n0
+  | n0 < 0    = error "Stream.(!!): negative index"
+  | otherwise = loop_index n0 s0
+  where
+    loop_index !n !s = case next s of
+      Done                   -> error "Stream.(!!): index too large"
+      Skip    s'             -> loop_index  n    s'
+      Yield x s' | n == 0    -> x
+                 | otherwise -> loop_index (n-1) s'
+{-# INLINE [0] index #-}
+
+-- | The 'findIndex' function takes a predicate and a stream and
+-- returns the index of the first element in the stream
+-- satisfying the predicate.
+findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
+findIndex p (Stream next s0 len) = loop_findIndex 0 s0
+  where
+    loop_findIndex !i !s = case next s of
+      Done                   -> Nothing
+      Skip    s'             -> loop_findIndex i     s' -- hmm. not caught by QC
+      Yield x s' | p x       -> Just i
+                 | otherwise -> loop_findIndex (i+1) s'
+{-# INLINE [0] findIndex #-}
+
+-- | /O(n)/ The 'elemIndex' function returns the index of the first
+-- element in the given stream which is equal to the query
+-- element, or 'Nothing' if there is no such element. 
+elemIndex :: Char -> Stream Char -> Maybe Int
+elemIndex a (Stream next s0 len) = loop_elemIndex 0 s0
+  where
+    loop_elemIndex !i !s = case next s of
+      Done                   -> Nothing
+      Skip    s'             -> loop_elemIndex i     s'
+      Yield x s' | a == x    -> Just i
+                 | otherwise -> loop_elemIndex (i+1) s'
+{-# INLINE [0] elemIndex #-}
+
+-------------------------------------------------------------------------------
+-- * Zipping
+
+-- | zipWith generalises 'zip' by zipping with the function given as
+-- the first argument, instead of a tupling function.
+zipWith :: (Char -> Char -> Char) -> Stream Char -> Stream Char -> Stream Char
+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: Nothing) (min len1 len2)
+    where
+      {-# INLINE next #-}
+      next (sa :!: sb :!: Nothing) = case next0 sa of
+                                       Done -> Done
+                                       Skip sa' -> Skip (sa' :!: sb :!: Nothing)
+                                       Yield a sa' -> Skip (sa' :!: sb :!: Just a)
+      
+      next (sa' :!: sb :!: Just a) = case next1 sb of
+                                       Done -> Done
+                                       Skip sb' -> Skip (sa' :!: sb' :!: Just a)
+                                       Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: Nothing)
+{-# INLINE [0] zipWith #-}
+
+errorEmptyList :: String -> a
+errorEmptyList fun =
+  error ("Prelude." ++ fun ++ ": empty list")
+module Text.Internal where
+
+import Data.Array.ST(newArray_,runSTUArray)
+import Data.Array.Unboxed(UArray(..))
+import Data.Word(Word16(..))
+
+data Text = Text !(UArray Int Word16) {-# UNPACK #-}!Int {-# UNPACK #-}!Int 
+
+empty :: Text
+empty = Text (runSTUArray (newArray_ (0,0))) 0 0 
+{-# INLINE [1] empty #-}

Text/UnsafeChar.hs

+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Text.UnsafeChar where
+
+import GHC.Exts
+import GHC.Word
+
+unsafeChr :: Word16 -> Char
+unsafeChr (W16# w#) = C# (chr# (word2Int# w#))
+{-# INLINE unsafeChr #-}
+
+unsafeChr8 :: Word8 -> Char
+unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#))
+{-# INLINE unsafeChr8 #-}
+
+unsafeChr32 :: Word32 -> Char
+unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
+{-# INLINE unsafeChr32 #-}
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Text.Utf16 where
+
+import GHC.Exts
+import GHC.Word
+
+import Data.Word
+
+chr2 :: Word16 -> Word16 -> Char
+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
+    where
+      x# = word2Int# a#
+      y# = word2Int# b#
+      upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#
+      lower# = y# -# 0xDC00#
+{-# INLINE chr2 #-}
+
+validate1    :: Word16 -> Bool
+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 < 0x10000)
+
+validate2       ::  Word16 -> Word16 -> Bool
+validate2 x1 x2 = (x1 >= 0xD800 && x1 <= 0xDBFF) &&
+                  (x2 >= 0xDC00 && x2 <= 0xDFFF)
+module Text.Utf32 where
+
+import Data.Bits
+import Char
+import Data.Word
+
+validate    :: Word32 -> Bool
+validate x1 = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)

Text/Utf32/Fusion.hs

+{-# OPTIONS_GHC -fbang-patterns #-}
+
+module Text.Utf32.Fusion where
+    
+import Text.Fusion hiding (stream, unstream)
+import Text.Utf32.Internal
+import Text.UnsafeChar
+import Data.Array.Base
+import Data.Word
+import Data.Array.ST
+import Control.Monad.ST
+import Char
+import Control.Monad
+
+stream :: Text -> Stream Char
+stream (Text arr off len) = Stream next off len
+    where    
+      end = off+len
+      {-# INLINE next #-}
+      next !i
+          | i >= end  = Done
+          | otherwise = Yield (unsafeChr32 (arr `unsafeAt` i)) (i+1)
+{-# INLINE [0] stream #-}
+
+unstream :: Stream Char -> Text
+unstream (Stream next0 s0 len) = x `seq` Text (fst x) 0 (snd x)
+    where
+      x :: ((UArray Int Word32),Int)
+      x = runST ((unsafeNewArray_ (0,len) :: ST s (STUArray s Int Word32)) 
+                 >>= (\arr -> loop arr 0 (len) s0))
+      loop arr !i !max !s
+          | i > max = do arr' <-unsafeNewArray_ (0,max*2)
+                         copy arr arr'
+                         loop arr' i (max*2) s
+          | otherwise = case next0 s of
+               Done       -> liftM2 (,) (unsafeFreezeSTUArray arr) (return i)
+               Skip s'    -> loop arr i max s'
+               Yield x s' -> do
+                 unsafeWrite arr i n
+                 loop arr (i+1) max s'
+                   where
+                     n :: Word32
+                     n = fromIntegral $ ord x
+{-# INLINE [0] unstream #-}
+
+{-# RULES 
+"STREAM stream/unstream fusion" forall s. 
+   stream (unstream s) = s 
+ #-}

Text/Utf32/Internal.hs

+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Text.Utf32.Internal where
+
+import Data.Array.Unboxed
+import Data.Word
+
+data Text = Text !(UArray Int Word32) !Int !Int
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module Text.Utf8 where
+
+import Char(ord)
+import Data.Bits
+import Data.Word
+
+import GHC.Exts
+import GHC.Prim
+import GHC.Word
+
+between       :: Word8 -> Word8 -> Word8 -> Bool 
+between x y z = x >= y && x <= z
+{-# INLINE between #-}
+
+ord2   :: Char -> (Word8,Word8)
+ord2 c = (x1,x2)
+    where
+      n  = ord c
+      x1 = fromIntegral $ (shiftR n 6) + (0xC0 :: Int) :: Word8
+      x2 = fromIntegral $ (n .&. 0x3F) + (0x80 :: Int) :: Word8
+
+ord3   :: Char -> (Word8,Word8,Word8)
+ord3 c = (x1,x2,x3)
+    where
+      n  = ord c
+      x1 = fromIntegral $ (shiftR n 12) + (0xE0::Int) :: Word8
+      x2 = fromIntegral $ ((shiftR n 6) .&. (0x3F::Int)) + (0x80::Int) :: Word8
+      x3 = fromIntegral $ (n .&. (0x3F::Int)) + (0x80::Int) :: Word8
+
+ord4   :: Char -> (Word8,Word8,Word8,Word8)
+ord4 c = (x1,x2,x3,x4)
+    where
+      n  = ord c 
+      x1 = fromIntegral $ (shiftR n 18) + (0xF0::Int) :: Word8
+      x2 = fromIntegral $ ((shiftR n 12) .&. (0x3F::Int)) + (0x80::Int) :: Word8
+      x3 = fromIntegral $ ((shiftR n 6) .&. (0x3F::Int)) + (0x80::Int) :: Word8
+      x4 = fromIntegral $ (n .&. (0x3F::Int)) + (0x80::Int) :: Word8
+
+chr2       :: Word8 -> Word8 -> Char
+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
+    where
+      y1# = word2Int# x1#
+      y2# = word2Int# x2#
+      z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
+      z2# = y2# -# 0x8F#
+{-# INLINE chr2 #-}
+
+chr3          :: Word8 -> Word8 -> Word8 -> Char
+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#)) 
+    where
+      y1# = word2Int# x1#
+      y2# = word2Int# x2#
+      y3# = word2Int# x3#
+      z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
+      z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
+      z3# = y3# -# 0x80#
+{-# INLINE chr3 #-}
+
+chr4             :: Word8 -> Word8 -> Word8 -> Word8 -> Char
+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) = 
+    C# (chr# (z1# +# z2# +# z3# +# z4#))
+    where
+      y1# = word2Int# x1#
+      y2# = word2Int# x2#
+      y3# = word2Int# x3#
+      y4# = word2Int# x4#
+      z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
+      z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
+      z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
+      z4# = y4# -# 0x80#
+{-# INLINE chr4 #-}
+
+validate1    :: Word8 -> Bool
+validate1 x1 = between x1 0x00 0x7F
+{-# INLINE validate1 #-}
+
+validate2       :: Word8 -> Word8 -> Bool
+validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF
+{-# INLINE validate2 #-}
+
+validate3          :: Word8 -> Word8 -> Word8 -> Bool
+validate3 x1 x2 x3 = validate3_1 x1 x2 x3 ||
+                     validate3_2 x1 x2 x3 ||
+                     validate3_3 x1 x2 x3 ||
+                     validate3_4 x1 x2 x3
+{-# INLINE validate3 #-}
+
+validate4             :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
+validate4 x1 x2 x3 x4 = validate4_1 x1 x2 x3 x4 ||
+                        validate4_2 x1 x2 x3 x4 ||
+                        validate4_3 x1 x2 x3 x4
+{-# INLINE validate4 #-}
+
+
+
+validate3_1 x1 x2 x3 = (x1 == 0xE0) && 
+                       between x2 0xA0 0xBF && 
+                       between x3 0x80 0xBF
+{-# INLINE validate3_1 #-}
+
+validate3_2 x1 x2 x3 = between x1 0xE1 0xEC &&
+                       between x2 0x80 0xBF &&
+                       between x3 0x80 0xBF
+{-# INLINE validate3_2 #-} 
+
+validate3_3 x1 x2 x3 = x1 == 0xED &&
+                       between x2 0x80 0x9F &&
+                       between x3 0x80 0xBF
+{-# INLINE validate3_3 #-}
+
+validate3_4 x1 x2 x3 = between x1 0xEE 0xEF &&
+                       between x2 0x80 0xBF &&
+                       between x2 0x80 0xBF
+{-# INLINE validate3_4 #-}
+
+
+validate4_1 x1 x2 x3 x4 = x1 == 0xF0 &&
+                          between x2 0x90 0xBF &&
+                          between x3 0x80 0xBF &&
+                          between x4 0x80 0xBF 
+{-# INLINE validate4_1 #-}
+
+validate4_2 x1 x2 x3 x4 = between x1 0xF1 0xF3 &&
+                          between x2 0x80 0xBF &&
+                          between x3 0x80 0xBF &&
+                          between x4 0x80 0xBF 
+{-# INLINE validate4_2 #-}
+
+validate4_3 x1 x2 x3 x4 = x1 == 0xF4 &&
+                          between x2 0x80 0x8F &&
+                          between x3 0x80 0xBF &&
+                          between x4 0x80 0xBF 
+{-# INLINE validate4_3 #-}     

Text/Utf8/Fusion.hs

+{-# OPTIONS_GHC -fbang-patterns -fglasgow-exts #-}
+
+module Text.Utf8.Fusion where
+
+import Data.Array.Base
+import Data.Word
+import Control.Monad.ST
+import Data.Text.UnsafeChar
+import Control.Monad
+import Char
+
+import Text.Utf8
+import Text.Utf8.Internal
+import Text.Fusion hiding (stream,unstream)
+
+stream :: Text -> Stream Char
+stream (Text arr off len) = Stream next off len
+    where
+      end = off+len
+      {-# INLINE next #-}
+      next !i
+          | i >= end = Done
+          | n <= 0x7F = Yield (unsafeChr8 n)    (i + 1)
+          | n <= 0xDF = Yield (chr2 n n2)       (i + 2)
+          | n <= 0xEF = Yield (chr3 n n2 n3)    (i + 3)
+          | otherwise = Yield (chr4 n n2 n3 n4) (i + 4)
+          where
+            n  = arr `unsafeAt`  i
+            n2 = arr `unsafeAt` (i + 1)
+            n3 = arr `unsafeAt` (i + 2)
+            n4 = arr `unsafeAt` (i + 3)
+{-# INLINE [0] stream #-}
+      
+
+unstream :: Stream Char -> Text
+unstream (Stream next0 s0 len) = x `seq` (Text (fst x) 0 (snd x))
+    where
+      x :: ((UArray Int Word8), Int)
+      x = runST ((unsafeNewArray_ (0,len+4) :: ST s (STUArray s Int Word8))
+                  >>= (\arr -> loop arr 0 (len+4) s0))
+      loop !arr !i !max !s
+          | i + 4 > max = do arr' <- unsafeNewArray_ (0,max*2)
+                             copy arr arr'
+                             loop arr' i (max*2) s
+          | otherwise = case next0 s of
+               Done       -> liftM2 (,) (unsafeFreezeSTUArray arr) (return i)
+               Skip s'    -> loop arr i max s'
+               Yield x s' 
+                   | n <= 0x7F -> do
+                        unsafeWrite arr i n
+                        loop arr (i+1) max s'
+                   | n <= 0x07FF -> do
+                        unsafeWrite arr i     (fst n2)
+                        unsafeWrite arr (i+1) (snd n2)
+                        loop arr (i+2) max s'
+                   | n <= 0xFFFF -> do
+                        unsafeWrite arr i     (fst3 n3)
+                        unsafeWrite arr (i+1) (snd3 n3)
+                        unsafeWrite arr (i+2) (trd3 n3)
+                        loop arr (i+3) max s'
+                   | otherwise  -> do
+                       unsafeWrite arr i     (fst4 n4)
+                       unsafeWrite arr (i+1) (snd4 n4)
+                       unsafeWrite arr (i+2) (trd4 n4)
+                       unsafeWrite arr (i+3) (fth4 n4)
+                       loop arr (i+4) max s'
+                   where
+                     n  = (fromIntegral . ord) x :: Word8
+                     n2 = ord2 x
+                     n3 = ord3 x
+                     n4 = ord4 x  
+                     fst3 !x = let (x1,_,_)   = x in x1
+                     snd3 !x = let (_,x2,_)   = x in x2
+                     trd3 !x = let (_,_,x3)   = x in x3
+                     fst4 !x = let (x1,_,_,_) = x in x1   
+                     snd4 !x = let (_,x2,_,_) = x in x2
+                     trd4 !x = let (_,_,x3,_) = x in x3
+                     fth4 !x = let (_,_,_,x4) = x in x4
+{-# INLINE [0] unstream #-}
+                    
+{-# RULES 
+"STREAM stream/unstream fusion" forall s. 
+   stream (unstream s) = s 
+ #-}

Text/Utf8/Internal.hs

+module Text.Utf8.Internal where
+    
+import Data.Array.Unboxed
+import Data.Word
+
+data Text = Text !(UArray Int Word8) !Int !Int