e2f1397 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Implement scanr

e2f1397Bryan O'Sullivan18 years ago

Data/Text.hs+13−2

compare with master

unifiedsplit

@@ -76,7 +76,7 @@ module Data.Text

76 -- ** Scans

77 , scanl

78 , scanl1

79− -- , scanr

79+ , scanr

80 -- , scanr1

82 -- ** Accumulating maps

@@ -157,7 +157,7 @@ import Data.Word (Word16)

157import Data.String (IsString(..))

158

159import qualified Data.Text.Fusion as S

160−import Data.Text.Fusion (Stream(..), Step(..), stream, unstream)

160+import Data.Text.Fusion (Stream(..), Step(..), stream, reverseStream, unstream)

161import Data.Text.Internal (Text(..), empty, text)

162import qualified Prelude as P

163import Data.Text.Unsafe (iter, iter_, unsafeHead, unsafeTail)

@@ -513,6 +513,17 @@ scanl1 f t | null t = empty

513 | otherwise = scanl f (unsafeHead t) (unsafeTail t)

514{-# INLINE scanl1 #-}

515

516+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.

517+--

518+-- > scanr f v t == reverse (scanl (flip f) v t)

519+scanr :: (Char -> Char -> Char) -> Char -> Text -> Text

520+scanr f z = S.reverse . S.reverseScanr f z . reverseStream

521+{-# INLINE scanr #-}

522+

523+shorten n t@(S.Stream arr off len) | n < len && n > 0 = S.Stream arr off n

524+ | otherwise = t

525+info (S.Stream _ _ len) = len

526+

516-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

527-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

517-- function to each element of a 'Text', passing an accumulating

528-- function to each element of a 'Text', passing an accumulating

518-- parameter from left to right, and returns a final 'Text'.

529-- parameter from left to right, and returns a final 'Text'.

Data/Text/UnsafeChar.hs+26−5

@@ -19,8 +19,10 @@ module Data.Text.UnsafeChar

19 , unsafeChr8

20 , unsafeChr32

21 , unsafeWrite

22+ , unsafeWriteRev

22 ) where

23 ) where

25+import Control.Exception (assert)

24import Control.Monad.ST (ST)

26import Control.Monad.ST (ST)

25import Data.Bits ((.&.), shiftR)

27import Data.Bits ((.&.), shiftR)

26import Data.Char (ord)

28import Data.Char (ord)

@@ -43,14 +45,33 @@ unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))

43unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int

45unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int

44unsafeWrite marr i c

46unsafeWrite marr i c

45 | n < 0x10000 = do

47 | n < 0x10000 = do

48+ assert (i >= 0) . assert (i < A.length marr) $

46− A.unsafeWrite marr i (fromIntegral n)

49+ A.unsafeWrite marr i (fromIntegral n)

47 return (i+1)

50 return (i+1)

48 | otherwise = do

51 | otherwise = do

52+ assert (i >= 0) . assert (i < A.length marr - 1) $

49− A.unsafeWrite marr i l

53+ A.unsafeWrite marr i lo

50− A.unsafeWrite marr (i+1) r

54+ A.unsafeWrite marr (i+1) hi

51 return (i+2)

55 return (i+2)

52 where n = ord c

56 where n = ord c

53 m = n - 0x10000

57 m = n - 0x10000

54− l = fromIntegral $ (m `shiftR` 10) + 0xD800

58+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800

55− r = fromIntegral $ (m .&. 0x3FF) + 0xDC00

59+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

56{-# INLINE unsafeWrite #-}

60{-# INLINE unsafeWrite #-}

61+

62+unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int

63+unsafeWriteRev marr i c

64+ | n < 0x10000 = do

65+ assert (i >= 0) . assert (i < A.length marr) $

66+ A.unsafeWrite marr i (fromIntegral n)

67+ return (i-1)

68+ | otherwise = do

69+ assert (i >= 1) . assert (i < A.length marr) $

70+ A.unsafeWrite marr (i-1) lo

71+ A.unsafeWrite marr i hi

72+ return (i-2)

73+ where n = ord c

74+ m = n - 0x10000

75+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800

76+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

77+{-# INLINE unsafeWriteRev #-}

tests/Properties.hs+21−5

@@ -14,7 +14,7 @@ import Data.Word

14import qualified Data.Text as T

15import Data.Text (pack,unpack)

16import qualified Data.Text.Fusion as S

17−import Data.Text.Fusion (unstream,stream)

17+import Data.Text.Fusion (stream, unstream)

18import qualified Data.List as L

@@ -22,16 +22,17 @@ import QuickCheckUtils

23prop_pack_unpack s = (unpack . pack) s == s

24prop_stream_unstream t = (unstream . stream) t == t

25+prop_reverse_stream t = (S.reverse . S.reverseStream) t == t

25prop_singleton c = [c] == (unpack . T.singleton) c

26prop_singleton c = [c] == (unpack . T.singleton) c

27-- Do two functions give the same answer?

28-- Do two functions give the same answer?

28eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool

29eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool

29eq a b s = a s == b s

30eq a b s = a s == b s

30-- What about with the RHS packed?

31-- What about with the RHS packed?

31−eqP :: (Eq a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool

32+eqP :: (Eq a, Show a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool

32−eqP a b s w = a s == b t &&

33+eqP a b s w = eq "orig" (a s) (b t) &&

33− a sa == b ta &&

34+ eq "head" (a sa) (b ta) &&

34− a sb == b tb

35+ eq "tail" (a sb) (b tb)

35 where t = pack s

36 where t = pack s

36 (sa,sb) = splitAt m s

37 (sa,sb) = splitAt m s

37 (ta,tb) = T.splitAt m t

38 (ta,tb) = T.splitAt m t

@@ -39,6 +40,8 @@ eqP a b s w = a s == b t &&

39 m | l == 0 = n

40 m | l == 0 = n

40 | otherwise = n `mod` l

41 | otherwise = n `mod` l

41 n = fromIntegral w

42 n = fromIntegral w

43+ eq s a b | a == b = True

44+ | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False

42-- Or with the string non-empty, and the RHS packed?

45-- Or with the string non-empty, and the RHS packed?

43eqEP :: (Eq a) =>

46eqEP :: (Eq a) =>

44 (String -> a) -> (T.Text -> a) -> NotEmpty String -> Word8 -> Bool

47 (String -> a) -> (T.Text -> a) -> NotEmpty String -> Word8 -> Bool

@@ -76,6 +79,7 @@ prop_intercalate c = L.intercalate c `eq` (unpack . T.intercalate (pack c) . m

76prop_intersperse c = L.intersperse c `eqP` (unpack . T.intersperse c)

79prop_intersperse c = L.intersperse c `eqP` (unpack . T.intersperse c)

77prop_transpose = L.transpose `eq` (map unpack . T.transpose . map pack)

80prop_transpose = L.transpose `eq` (map unpack . T.transpose . map pack)

78prop_reverse = L.reverse `eqP` (unpack . T.reverse)

81prop_reverse = L.reverse `eqP` (unpack . T.reverse)

82+prop_reverse_short n = L.reverse `eqP` (unpack . S.reverse . shorten n . stream)

80prop_foldl f z = L.foldl f z `eqP` (T.foldl f z)

84prop_foldl f z = L.foldl f z `eqP` (T.foldl f z)

81 where types = f :: Char -> Char -> Char

85 where types = f :: Char -> Char -> Char

@@ -96,6 +100,7 @@ prop_minimum = L.minimum `eqEP` T.minimum

100

97prop_scanl f z = L.scanl f z `eqP` (unpack . T.scanl f z)

101prop_scanl f z = L.scanl f z `eqP` (unpack . T.scanl f z)

98prop_scanl1 f = L.scanl1 f `eqP` (unpack . T.scanl1 f)

102prop_scanl1 f = L.scanl1 f `eqP` (unpack . T.scanl1 f)

103+prop_scanr f z = L.scanr f z `eqP` (unpack . T.scanr f z)

104

100prop_mapAccumL f z = (snd . L.mapAccumL f z)`eqP` (unpack . T.mapAccumL f z)

105prop_mapAccumL f z = (snd . L.mapAccumL f z)`eqP` (unpack . T.mapAccumL f z)

101 where types = f :: Int -> Char -> (Int,Char)

106 where types = f :: Int -> Char -> (Int,Char)

@@ -168,6 +173,14 @@ prop_elemIndices c = L.elemIndices c`eqP` T.elemIndices c

168prop_count c = (L.length . L.elemIndices c) `eqP` T.count c

173prop_count c = (L.length . L.elemIndices c) `eqP` T.count c

169prop_zipWith c s = L.zipWith c s `eqP` (unpack . T.zipWith c (pack s))

174prop_zipWith c s = L.zipWith c s `eqP` (unpack . T.zipWith c (pack s))

170

175

176+-- Make a stream appear shorter than it really is, to ensure that

177+-- functions that consume inaccurately sized streams behave

178+-- themselves.

179+shorten :: Int -> S.Stream a -> S.Stream a

180+shorten n t@(S.Stream arr off len)

181+ | n < len && n > 0 = S.Stream arr off n

182+ | otherwise = t

183+

171main = run tests =<< getArgs

184main = run tests =<< getArgs

172

185

173run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()

186run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()

@@ -185,6 +198,7 @@ tests :: [(String, Int -> IO (Bool, Int))]

185tests = [

198tests = [

186 ("prop_pack_unpack", mytest prop_pack_unpack),

199 ("prop_pack_unpack", mytest prop_pack_unpack),

187 ("prop_stream_unstream", mytest prop_stream_unstream),

200 ("prop_stream_unstream", mytest prop_stream_unstream),

201+ ("prop_reverse_stream", mytest prop_reverse_stream),

188 ("prop_singleton", mytest prop_singleton),

202 ("prop_singleton", mytest prop_singleton),

189

203

190 ("prop_cons", mytest prop_cons),

204 ("prop_cons", mytest prop_cons),

@@ -207,6 +221,7 @@ tests = [

207 ("prop_intersperse", mytest prop_intersperse),

221 ("prop_intersperse", mytest prop_intersperse),

208 ("prop_transpose", mytest prop_transpose),

222 ("prop_transpose", mytest prop_transpose),

209 ("prop_reverse", mytest prop_reverse),

223 ("prop_reverse", mytest prop_reverse),

224+ ("prop_reverse_short", mytest prop_reverse_short),

210

225

211 ("prop_foldl", mytest prop_foldl),

226 ("prop_foldl", mytest prop_foldl),

212 ("prop_foldl'", mytest prop_foldl'),

227 ("prop_foldl'", mytest prop_foldl'),

@@ -224,6 +239,7 @@ tests = [

224

239

225 ("prop_scanl", mytest prop_scanl),

240 ("prop_scanl", mytest prop_scanl),

226 ("prop_scanl1", mytest prop_scanl1),

241 ("prop_scanl1", mytest prop_scanl1),

242+ ("prop_scanr", mytest prop_scanr),

227

243

228 ("prop_mapAccumL", mytest prop_mapAccumL),

244 ("prop_mapAccumL", mytest prop_mapAccumL),

229

245