Commits

Bryan O'Sullivan committed 884fe7f

Another try at improving Text generation.

Comments (0)

Files changed (2)

                 fromIntegral, otherwise)
 import Data.Bits ((.&.))
 import Data.Text.Internal (Text(..))
+import Data.Text.Private (runText)
 import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)
 import Data.Text.UnsafeShift (shiftL, shiftR)
 import qualified Data.Text.Array as A
 
 -- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
 unstream :: Stream Char -> Text
-unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)
+unstream (Stream next0 s0 len) = a
   where
-    a = A.run2 (A.new mlen >>= \arr -> outer arr mlen s0 0)
+    a = runText (\done -> A.new mlen >>= \arr -> outer done arr mlen s0 0)
       where mlen = upperBound 4 len
-    outer arr top = loop
+    outer done arr top = loop
       where
         loop !s !i =
             case next0 s of
-              Done          -> return (arr, i)
+              Done          -> done arr i
               Skip s'       -> loop s' i
               Yield x s'
                 | j >= top  -> {-# SCC "unstream/resize" #-} do
                                let top' = (top + 1) `shiftL` 1
                                arr' <- A.new top'
                                A.copyM arr' 0 arr 0 top
-                               outer arr' top' s i
+                               outer done arr' top' s i
                 | otherwise -> do d <- unsafeWrite arr i x
                                   loop s' (i+d)
                 where j | ord x < 0x10000 = i
-{-# LANGUAGE BangPatterns, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
 
 -- |
 -- Module      : Data.Text.Private
 
 module Data.Text.Private
     (
-      span_
+      runText
+    , span_
     ) where
 
+import Control.Monad.ST (ST, runST)
 import Data.Text.Internal (Text(..), textP)
 import Data.Text.Unsafe (Iter(..), iter)
+import qualified Data.Text.Array as A
 
 span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
 span_ p t@(Text arr off len) = (# hd,tl #)
                 | otherwise      = i
             where Iter c d       = iter t i
 {-# INLINE span_ #-}
+
+runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
+runText act = runST (act $ \ !marr !len -> do
+                             arr <- A.unsafeFreeze marr
+                             return $! textP arr 0 len)
+{-# INLINE runText #-}