@@ -0,0 +1,68 @@
1+-- |
2+-- Module : Data.Text.Lazy.Fusion
3+-- Copyright : (c) Tom Harper 2008-2009,
4+-- (c) Bryan O'Sullivan 2009,
5+-- (c) Duncan Coutts 2009
6+--
7+-- License : BSD-style
8+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
9+-- duncan@haskell.org
10+-- Stability : experimental
11+-- Portability : GHC
12+--
13+-- Core stream fusion functionality for text.
14+
15+module Data.Text.Lazy.Fusion
16+ (
17+ stream
18+ , unstream
19+ ) where
20+
21+import Data.Text.Fusion.Internal
22+import Data.Text.Lazy.Internal
23+import qualified Data.Text.Internal as I
24+import qualified Data.Text.Array as A
25+import qualified Data.Text.Encoding.Utf16 as U16
26+import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
27+import Data.Text.Unsafe (iter)
28+
29+default(Int)
30+
31+stream :: Text -> Stream Char
32+stream text = Stream next (text :!: 0) 4
33+ where
34+ next (Empty :!: _) = Done
35+ next (txt@(Chunk t@(I.Text _ _ len) ts) :!: i)
36+ | i >= len = next (ts :!: 0)
37+ | otherwise = Yield c (txt :!: i+d)
38+ where (c,d) = iter t i
39+{-# INLINE [0] stream #-}
40+
41+unstream :: Stream Char -> Text
42+unstream (Stream next s0 len0)
43+ | len0 == 0 = Empty
44+ | otherwise = outer s0
45+ where
46+ outer s = case next s of
47+ Done -> Empty
48+ Skip s' -> outer s'
49+ Yield x s' -> chunk t (outer s'')
50+ where (t,s'') = fill x s'
51+ fill x s = (I.Text a 0 l,s')
52+ where (a,(s',l)) = A.run2 (A.unsafeNew initLen >>= (\arr -> inner arr initLen x s 0))
53+ initLen = 8
54+ inner marr len x s i
55+ | i + 1 >= defaultChunkSize = return (marr, (s,i))
56+ | i + 1 >= len = do
57+ let newLen = min (len * 2) defaultChunkSize
58+ marr' <- A.unsafeNew newLen
59+ A.copy marr marr'
60+ inner marr' newLen x s i
61+ | otherwise =
62+ case next s of
63+ Done -> do i' <- unsafeWrite marr i x
64+ return (marr,(s,i'))
65+ Skip s' -> inner marr len x s i
66+ Yield x' s' -> unsafeWrite marr i x >>= inner marr len x' s'
67+{-# INLINE [0] unstream #-}
68+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}