@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, Rank2Types #-}
22{-# OPTIONS_GHC -fno-warn-orphans #-}
33
44-- |
@@ -164,10 +164,12 @@ module Data.Text
164164import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,
165165 Eq(..), Ord(..), (++),
166166 Read(..), Show(..),
167− (&&), (||), (+), (-), (.), ($),
167+ (&&), (||), (+), (-), (.), ($), (>>),
168168 fromIntegral, div, not, return, otherwise)
169+import Control.DeepSeq (NFData)
169170import Control.Exception (assert)
170171import Data.Char (isSpace)
172+import Control.Monad (foldM)
171173import Control.Monad.ST (ST)
172174import qualified Data.Text.Array as A
173175import qualified Data.List as L
@@ -212,6 +214,8 @@ instance Monoid Text where
212214instance IsString Text where
213215 fromString = pack
214216
217+instance NFData Text
218+
215219-- -----------------------------------------------------------------------------
216220-- * Conversion to/from 'Text'
217221
@@ -254,15 +258,10 @@ append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (A.run x) 0 len
254258 where
255259 len = len1+len2
256260 x = do
257− arr <- A.unsafeNew len :: ST s (A.MArray s Word16)
258− copy arr1 off1 (len1+off1) arr 0
259− copy arr2 off2 (len2+off2) arr len1
261+ arr <- A.unsafeNew len
262+ copy arr 0 arr1 off1 len1
263+ copy arr len1 arr2 off2 (len1+len2)
260264 return arr
261− where
262− copy arr i top arr' j
263− | i >= top = return ()
264− | otherwise = do A.unsafeWrite arr' j (arr `A.unsafeIndex` i)
265− copy arr (i+1) top arr' (j+1)
266265{-# INLINE append #-}
267266
268267{-# RULES
@@ -272,6 +271,14 @@ append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (A.run x) 0 len
272271 unstream (S.append (stream t1) (stream t2)) = append t1 t2
273272 #-}
274273
274+copy :: forall s. A.MArray s Word16 -> Int -> A.Array Word16 -> Int -> Int
275+ -> ST s ()
276+copy dest i0 src j0 top = go i0 j0
277+ where
278+ go i j | i >= top = return ()
279+ | otherwise = do A.unsafeWrite dest i (src `A.unsafeIndex` j)
280+ go (i+1) (j+1)
281+
275282-- | /O(1)/ Returns the first character of a 'Text', which must be
276283-- non-empty. Subject to fusion.
277284head :: Text -> Char
@@ -555,9 +562,15 @@ foldr1 f t = S.foldr1 f (stream t)
555562-- -----------------------------------------------------------------------------
556563-- ** Special folds
557564
558−-- | /O(n)/ Concatenate a list of 'Text's. Subject to fusion.
565+-- | /O(n)/ Concatenate a list of 'Text's.
559566concat :: [Text] -> Text
560−concat ts = unstream (S.concat (L.map stream ts))
567+concat ts = Text (A.run go) 0 len
568+ where
569+ len = L.sum (L.map (\(Text _ _ l) -> l) ts)
570+ go = do
571+ arr <- A.unsafeNew len
572+ let step i (Text a o l) = let j = i + l in copy arr i a o j >> return j
573+ foldM step 0 ts >> return arr
561574{-# INLINE concat #-}
562575
563576-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and