e2f1397 · text · git.iko.soy

git.iko.soy/text

Implement scanr

--HG-- extra : convert_revision : 5d26d5056e6545a1019027955d844d2bbf78e52c

commite2f139778e7b1791caa0d4044dded66584df5f9b authorBryan O'Sullivan <bos@serpentine.com> dateSun 22 Feb 2009, 09:06 (18 years ago) parent086f118

3 files changed+60−12

compare with master

unifiedsplit

Data/Text.hs+13−2 Data/Text/UnsafeChar.hs+26−5 tests/Properties.hs+21−5

Data/Text.hs+13−2

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

7676 -- ** Scans

7777 , scanl

7878 , scanl1

79− -- , scanr

79+ , scanr

8080 -- , scanr1

8181

8282 -- ** Accumulating maps

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

157157import Data.String (IsString(..))

158158

159159import 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)

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

162162import qualified Prelude as P

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

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

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

514514{-# INLINE scanl1 #-}

515515

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+

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

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

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

Data/Text/UnsafeChar.hs+26−5

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

1919 , unsafeChr8

2020 , unsafeChr32

2121 , unsafeWrite

22+ , unsafeWriteRev

2223 ) where

2324

25+import Control.Exception (assert)

2426import Control.Monad.ST (ST)

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

2628import Data.Char (ord)

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

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

4446unsafeWrite marr i c

4547 | n < 0x10000 = do

46− A.unsafeWrite marr i (fromIntegral n)

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

49+ A.unsafeWrite marr i (fromIntegral n)

4750 return (i+1)

4851 | otherwise = do

49− A.unsafeWrite marr i l

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

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

53+ A.unsafeWrite marr i lo

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

5155 return (i+2)

5256 where n = ord c

5357 m = n - 0x10000

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

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

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

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

5660{-# 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

1414import qualified Data.Text as T

1515import Data.Text (pack,unpack)

1616import qualified Data.Text.Fusion as S

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

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

1818import qualified Data.List as L

1919

2020

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

2222

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

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

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

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

2627

2728-- Do two functions give the same answer?

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

2930eq a b s = a s == b s

3031-- What about with the RHS packed?

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

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

33− a sa == b ta &&

34− a sb == b tb

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

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

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

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

3536 where t = pack s

3637 (sa,sb) = splitAt m s

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

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

3940 m | l == 0 = n

4041 | otherwise = n `mod` l

4142 n = fromIntegral w

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

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

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

4346eqEP :: (Eq a) =>

4447 (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

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

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

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

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

7983

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

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

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

96100

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

98102prop_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)

99104

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

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

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

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

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

170175

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+

171184main = run tests =<< getArgs

172185

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

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

185198tests = [

186199 ("prop_pack_unpack", mytest prop_pack_unpack),

187200 ("prop_stream_unstream", mytest prop_stream_unstream),

201+ ("prop_reverse_stream", mytest prop_reverse_stream),

188202 ("prop_singleton", mytest prop_singleton),

189203

190204 ("prop_cons", mytest prop_cons),

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

207221 ("prop_intersperse", mytest prop_intersperse),

208222 ("prop_transpose", mytest prop_transpose),

209223 ("prop_reverse", mytest prop_reverse),

224+ ("prop_reverse_short", mytest prop_reverse_short),

210225

211226 ("prop_foldl", mytest prop_foldl),

212227 ("prop_foldl'", mytest prop_foldl'),

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

224239

225240 ("prop_scanl", mytest prop_scanl),

226241 ("prop_scanl1", mytest prop_scanl1),

242+ ("prop_scanr", mytest prop_scanr),

227243

228244 ("prop_mapAccumL", mytest prop_mapAccumL),

229245