Commits

Bryan O'Sullivan committed efbfe99

Implement lazy length, and test it

Comments (0)

Files changed (3)

Data/Text/Fusion.hs

     , init
     , null
     , length
+    , length64
 
     -- * Transformations
     , map
 import GHC.Exts (Int(..), (+#))
 import Data.Bits ((.&.), shiftR)
 import Data.Char (ord)
+import Data.Int (Int64)
 import Data.Text.Internal (Text(..))
 import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
 import qualified Data.Text.Array as A
                             Yield _ s' -> loop_length (z# +# 1#) s'
 {-# INLINE[0] length #-}
 
+-- | /O(n)/ Returns the number of characters in a text.
+length64 :: Stream Char -> Int64
+length64 (Stream next s0 _len) = loop_length 0 s0
+    where
+      loop_length z s  = case next s of
+                           Done       -> z
+                           Skip    s' -> loop_length z s'
+                           Yield _ s' -> let !z' = z + 1
+                                         in loop_length z' s'
+{-# INLINE[0] length64 #-}
+
 -- ----------------------------------------------------------------------------
 -- * Stream transformations
 

Data/Text/Lazy.hs

     , tail
     , init
     , null
-    -- , length
+    , length
 
     -- * Transformations
     -- , map
                 Eq(..), Ord(..), (++),
                 Read(..), Show(..),
                 (&&), (||), (+), (-), (.), ($),
-                not, return, otherwise)
+                fromIntegral, not, return, otherwise)
 import qualified Prelude as P
+import Data.Int (Int64)
 import Data.String (IsString(..))
 import qualified Data.Text as T
 import qualified Data.Text.Fusion as S
     S.null (stream t) = null t
  #-}
 
+length :: Text -> Int64
+length = foldlChunks go 0
+    where go l t = l + fromIntegral (T.length t)
+{-# INLINE [1] length #-}
+
+{-# RULES
+"LAZY TEXT length -> fused" [~1] forall t.
+    length t = S.length64 (stream t)
+"LAZY TEXT length -> unfused" [1] forall t.
+    S.length64 (stream t) = length t
+ #-}
+
 -- | /O(1)/ Returns the last character of a 'Text', which must be
 -- non-empty.  Subject to array fusion.
 last :: Text -> Char

tests/Properties.hs

 prop_S_null            = null   `eqP`  S.null
 prop_T_null            = null   `eqP`  T.null
 prop_TL_null           = null   `eqP`  TL.null
+prop_S_length          = length `eqP`  S.length
+prop_S_length64        = length `eqP`  (fromIntegral . S.length64)
 prop_T_length          = length `eqP`  T.length
+prop_TL_length         = length `eqP`  (fromIntegral . TL.length)
 prop_T_map f           = map f  `eqP`  (unpackT . T.map f)
 prop_T_intercalate c   = L.intercalate c `eq` (unpackT . T.intercalate (T.pack c) . map T.pack)
 prop_T_intersperse c   = L.intersperse c `eqP` (unpackT . T.intersperse c)
   ("prop_S_null", mytest prop_S_null),
   ("prop_T_null", mytest prop_T_null),
   ("prop_TL_null", mytest prop_TL_null),
+  ("prop_S_length", mytest prop_S_length),
+  ("prop_S_length64", mytest prop_S_length64),
   ("prop_T_length", mytest prop_T_length),
+  ("prop_TL_length", mytest prop_TL_length),
 
   ("prop_T_map", mytest prop_T_map),
   ("prop_T_intercalate", mytest prop_T_intercalate),