@@ -0,0 +1,312 @@
1+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
3+-----------------------------------------------------------------------------
5+-- Module : Data.Text.Lazy.Builder.Internal
6+-- Copyright : (c) 2010 Johan Tibell
7+-- License : BSD3-style (see LICENSE)
9+-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
10+-- Stability : experimental
11+-- Portability : portable to Hugs and GHC
13+-- Efficient construction of lazy @Text@ values. The principal
14+-- operations on a @Builder@ are @singleton@, @fromText@, and
15+-- @fromLazyText@, which construct new builders, and 'mappend', which
16+-- concatenates two builders.
18+-- To get maximum performance when building lazy @Text@ values using a builder, associate @mappend@ calls to the right. For example, prefer
20+-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')
24+-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'
26+-- as the latter associates @mappend@ to the left.
28+-----------------------------------------------------------------------------
30+module Data.Text.Lazy.Builder.Internal
31+ ( -- * The Builder type
36+ -- * Constructing Builders
42+ -- * Flushing the buffer state
46+import Control.Monad.ST (ST, runST)
47+import Data.Bits ((.&.))
48+import Data.Monoid (Monoid(..))
49+import Data.Text.Internal (Text(..))
50+import Data.Text.Lazy.Internal (smallChunkSize)
51+import Data.Text.Unsafe (inlineInterleaveST)
52+import Data.Text.UnsafeChar (ord, unsafeWrite)
53+import Data.Text.UnsafeShift (shiftR)
54+import Prelude hiding (map, putChar)
56+import qualified Data.String as String
57+import qualified Data.Text as S
58+import qualified Data.Text.Array as A
59+import qualified Data.Text.Lazy as L
61+------------------------------------------------------------------------
63+-- | A @Builder@ is an efficient way to build lazy @Text@ values.
64+-- There are several functions for constructing builders, but only one
65+-- to inspect them: to extract any data, you have to turn them into
66+-- lazy @Text@ values using @toLazyText@.
68+-- Internally, a builder constructs a lazy @Text@ by filling arrays
69+-- piece by piece. As each buffer is filled, it is \'popped\' off, to
70+-- become a new chunk of the resulting lazy @Text@. All this is
71+-- hidden from the user of the @Builder@.
72+newtype Builder = Builder {
73+ -- Invariant (from Data.Text.Lazy):
74+ -- The lists include no null Texts.
75+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])
80+instance Monoid Builder where
82+ {-# INLINE mempty #-}
84+ {-# INLINE mappend #-}
85+ mconcat = foldr mappend mempty
86+ {-# INLINE mconcat #-}
88+instance String.IsString Builder where
89+ fromString = fromString
90+ {-# INLINE fromString #-}
92+instance Show Builder where
93+ show = show . toLazyText
95+instance Eq Builder where
96+ a == b = toLazyText a == toLazyText b
98+instance Ord Builder where
99+ a <= b = toLazyText a <= toLazyText b
101+------------------------------------------------------------------------
103+-- | /O(1)./ The empty @Builder@, satisfying
105+-- * @'toLazyText' 'empty' = 'L.empty'@
108+empty = Builder (\ k buf -> k buf)
111+-- | /O(1)./ A @Builder@ taking a single character, satisfying
113+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
115+singleton :: Char -> Builder
116+singleton c = writeAtMost 2 $ \ marr o ->
118+ then A.unsafeWrite marr o (fromIntegral n) >> return 1
120+ A.unsafeWrite marr o lo
121+ A.unsafeWrite marr (o+1) hi
125+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
126+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
127+{-# INLINE singleton #-}
129+------------------------------------------------------------------------
131+-- | /O(1)./ The concatenation of two builders, an associative
132+-- operation with identity 'empty', satisfying
134+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@
136+append :: Builder -> Builder -> Builder
137+append (Builder f) (Builder g) = Builder (f . g)
138+{-# INLINE [0] append #-}
140+-- TODO: Experiment to find the right threshold.
144+-- This function attempts to merge small @Text@ values instead of
145+-- treating each value as its own chunk. We may not always want this.
147+-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying
149+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
151+fromText :: S.Text -> Builder
152+fromText t@(Text arr off l)
154+ | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
155+ | otherwise = flush `append` mapBuilder (t :)
156+{-# INLINE [1] fromText #-}
159+"fromText/pack" forall s .
160+ fromText (S.pack s) = fromString s
163+-- | /O(1)./ A Builder taking a @String@, satisfying
165+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@
167+fromString :: String -> Builder
168+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
169+ let loop !marr !o !u !l [] = k (Buffer marr o u l)
170+ loop marr o u l s@(c:cs)
172+ arr <- A.unsafeFreeze marr
173+ let !t = Text arr o u
174+ marr' <- A.new chunkSize
175+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
178+ n <- unsafeWrite marr (o+u) c
179+ loop marr o (u+n) (l-n) cs
180+ in loop p0 o0 u0 l0 str
182+ chunkSize = smallChunkSize
183+{-# INLINE fromString #-}
185+-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
187+-- * @'toLazyText' ('fromLazyText' t) = t@
189+fromLazyText :: L.Text -> Builder
190+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)
191+{-# INLINE fromLazyText #-}
193+------------------------------------------------------------------------
195+-- Our internal buffer type
196+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
197+ {-# UNPACK #-} !Int -- offset
198+ {-# UNPACK #-} !Int -- used units
199+ {-# UNPACK #-} !Int -- length left
201+------------------------------------------------------------------------
203+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default
204+-- buffer size. The construction work takes place if and when the
205+-- relevant part of the lazy @Text@ is demanded.
206+toLazyText :: Builder -> L.Text
207+toLazyText = toLazyTextWith smallChunkSize
209+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given
210+-- size for the initial buffer. The construction work takes place if
211+-- and when the relevant part of the lazy @Text@ is demanded.
213+-- If the initial buffer is too small to hold all data, subsequent
214+-- buffers will be the default buffer size.
215+toLazyTextWith :: Int -> Builder -> L.Text
216+toLazyTextWith chunkSize m = L.fromChunks (runST $
217+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))
219+-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
220+-- yielding a new chunk in the result lazy @Text@.
222+flush = Builder $ \ k buf@(Buffer p o u l) ->
225+ else do arr <- A.unsafeFreeze p
226+ let !b = Buffer p (o+u) 0 l
228+ ts <- inlineInterleaveST (k b)
231+------------------------------------------------------------------------
233+-- | Sequence an ST operation on the buffer
234+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder
235+withBuffer f = Builder $ \k buf -> f buf >>= k
236+{-# INLINE withBuffer #-}
238+-- | Get the size of the buffer
239+withSize :: (Int -> Builder) -> Builder
240+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
241+ runBuilder (f l) k buf
242+{-# INLINE withSize #-}
244+-- | Map the resulting list of texts.
245+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder
246+mapBuilder f = Builder (fmap f .)
248+------------------------------------------------------------------------
250+-- | Ensure that there are at least @n@ many elements available.
251+ensureFree :: Int -> Builder
252+ensureFree !n = withSize $ \ l ->
255+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
256+{-# INLINE [0] ensureFree #-}
258+writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
259+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
260+{-# INLINE [0] writeAtMost #-}
262+-- | Ensure that @n@ many elements are available, and then use @f@ to
263+-- write some elements into the memory.
264+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
265+writeN n f = writeAtMost n (\ p o -> f p o >> return n)
266+{-# INLINE writeN #-}
268+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
269+writeBuffer f (Buffer p o u l) = do
271+ return $! Buffer p o (u+n) (l-n)
272+{-# INLINE writeBuffer #-}
274+newBuffer :: Int -> ST s (Buffer s)
277+ return $! Buffer arr 0 0 size
278+{-# INLINE newBuffer #-}
280+------------------------------------------------------------------------
281+-- Some nice rules for Builder
283+-- This function makes GHC understand that 'writeN' and 'ensureFree'
284+-- are *not* recursive in the precense of the rewrite rules below.
285+-- This is not needed with GHC 7+.
286+append' :: Builder -> Builder -> Builder
287+append' (Builder f) (Builder g) = Builder (f . g)
288+{-# INLINE append' #-}
292+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
293+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.
294+ append (writeAtMost a f) (append (writeAtMost b g) ws) =
295+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
296+ g marr (o+n) >>= \ m ->
297+ let s = n+m in s `seq` return s)) ws
299+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
300+ (g::forall s. A.MArray s -> Int -> ST s Int).
301+ append (writeAtMost a f) (writeAtMost b g) =
302+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
303+ g marr (o+n) >>= \ m ->
304+ let s = n+m in s `seq` return s)
306+"ensureFree/ensureFree" forall a b .
307+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)
310+ append flush flush = flush