@@ -82,6 +82,8 @@ instance Monoid Builder where
82 {-# INLINE mempty #-}
82 {-# INLINE mempty #-}
83 mappend = append
83 mappend = append
84 {-# INLINE mappend #-}
84 {-# INLINE mappend #-}
85+ mconcat = foldr mappend mempty
86+ {-# INLINE mconcat #-}
86instance String.IsString Builder where
88instance String.IsString Builder where
87 fromString = fromString
89 fromString = fromString
@@ -97,7 +99,7 @@ instance Show Builder where
97-- * @'toLazyText' 'empty' = 'L.empty'@
99-- * @'toLazyText' 'empty' = 'L.empty'@
99empty :: Builder
101empty :: Builder
100−empty = Builder id
102+empty = Builder (\ k buf -> k buf)
101{-# INLINE empty #-}
103{-# INLINE empty #-}
103-- | /O(1)./ A @Builder@ taking a single character, satisfying
105-- | /O(1)./ A @Builder@ taking a single character, satisfying
@@ -105,7 +107,17 @@ empty = Builder id
105-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
107-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@
107singleton :: Char -> Builder
109singleton :: Char -> Builder
108−singleton c = putChar c
110+singleton c = writeAtMost 2 $ \ marr o ->
112+ then A.unsafeWrite marr o (fromIntegral n) >> return 1
114+ A.unsafeWrite marr o lo
115+ A.unsafeWrite marr (o+1) hi
119+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
120+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
109{-# INLINE singleton #-}
121{-# INLINE singleton #-}
111------------------------------------------------------------------------
123------------------------------------------------------------------------
@@ -229,20 +241,6 @@ mapBuilder f = Builder (fmap f .)
230------------------------------------------------------------------------
242------------------------------------------------------------------------
232−putChar :: Char -> Builder
234− | n < 0x10000 = writeN 1 $ \marr o -> A.unsafeWrite marr o (fromIntegral n)
235− | otherwise = writeN 2 $ \marr o -> do
236− A.unsafeWrite marr o lo
237− A.unsafeWrite marr (o+1) hi
240− lo = fromIntegral $ (m `shiftR` 10) + 0xD800
241− hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
242−{-# INLINE putChar #-}
244−------------------------------------------------------------------------
246-- | Ensure that there are at least @n@ many elements available.
244-- | Ensure that there are at least @n@ many elements available.
247ensureFree :: Int -> Builder
245ensureFree :: Int -> Builder
248ensureFree !n = withSize $ \ l ->
246ensureFree !n = withSize $ \ l ->
@@ -251,18 +249,21 @@ ensureFree !n = withSize $ \ l ->
251 else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
249 else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))
252{-# INLINE [0] ensureFree #-}
250{-# INLINE [0] ensureFree #-}
252+writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder
253+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)
254+{-# INLINE [0] writeAtMost #-}
254-- | Ensure that @n@ many elements are available, and then use @f@ to
256-- | Ensure that @n@ many elements are available, and then use @f@ to
255-- write some elements into the memory.
257-- write some elements into the memory.
256writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
258writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
257−writeN n f = ensureFree n `append'` withBuffer (writeNBuffer n f)
259+writeN n f = writeAtMost n (\ p o -> f p o >> return n)
258−{-# INLINE [0] writeN #-}
260+{-# INLINE writeN #-}
260−writeNBuffer :: Int -> (A.MArray s -> Int -> ST s ()) -> (Buffer s)
262+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)
262−writeNBuffer n f (Buffer p o u l) = do
263+writeBuffer f (Buffer p o u l) = do
263− f p (o+u)
264+ n <- f p (o+u)
264 return $! Buffer p o (u+n) (l-n)
265 return $! Buffer p o (u+n) (l-n)
265−{-# INLINE writeNBuffer #-}
266+{-# INLINE writeBuffer #-}
267newBuffer :: Int -> ST s (Buffer s)
268newBuffer :: Int -> ST s (Buffer s)
268newBuffer size = do
269newBuffer size = do
@@ -275,27 +276,31 @@ newBuffer size = do
276-- This function makes GHC understand that 'writeN' and 'ensureFree'
277-- This function makes GHC understand that 'writeN' and 'ensureFree'
277-- are *not* recursive in the precense of the rewrite rules below.
278-- are *not* recursive in the precense of the rewrite rules below.
278−-- This is not needed with GHC 6.14+.
279+-- This is not needed with GHC 7+.
279append' :: Builder -> Builder -> Builder
280append' :: Builder -> Builder -> Builder
280append' (Builder f) (Builder g) = Builder (f . g)
281append' (Builder f) (Builder g) = Builder (f . g)
281{-# INLINE append' #-}
282{-# INLINE append' #-}
285−"append/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
286+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
286− (g::forall s. A.MArray s -> Int -> ST s ()) ws.
287+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.
287− append (writeN a f) (append (writeN b g) ws) =
288+ append (writeAtMost a f) (append (writeAtMost b g) ws) =
288− append (writeN (a+b) (\marr o -> f marr o >> g marr (o+a))) ws
289+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
290+ g marr (o+n) >>= \ m ->
291+ let s = n+m in s `seq` return s)) ws
290−"writeN/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
293+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)
291− (g::forall s. A.MArray s -> Int -> ST s ()).
294+ (g::forall s. A.MArray s -> Int -> ST s Int).
292− append (writeN a f) (writeN b g) =
295+ append (writeAtMost a f) (writeAtMost b g) =
293− writeN (a+b) (\marr o -> f marr o >> g marr (o+a))
296+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->
297+ g marr (o+n) >>= \ m ->
298+ let s = n+m in s `seq` return s)
295"ensureFree/ensureFree" forall a b .
300"ensureFree/ensureFree" forall a b .
296− append (ensureFree a) (ensureFree b) = ensureFree (max a b)
301+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)
298"flush/flush"
303"flush/flush"
299− append flush flush = flush
304+ append flush flush = flush