Bryan O'Sullivan avatar Bryan O'Sullivan committed 406de7b

Implement scanr

Comments (0)

Files changed (3)

     -- ** Scans
     , scanl
     , scanl1
-    -- , scanr
+    , scanr
     -- , scanr1
 
     -- ** Accumulating maps
 import Data.String (IsString(..))
 
 import qualified Data.Text.Fusion as S
-import Data.Text.Fusion (Stream(..), Step(..), stream, unstream)
+import Data.Text.Fusion (Stream(..), Step(..), stream, reverseStream, unstream)
 import Data.Text.Internal (Text(..), empty, text)
 import qualified Prelude as P
 import Data.Text.Unsafe (iter, iter_, unsafeHead, unsafeTail)
            | otherwise = scanl f (unsafeHead t) (unsafeTail t)
 {-# INLINE scanl1 #-}
 
+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.
+--
+-- > scanr f v t == reverse (scanl (flip f) v t)
+scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
+scanr f z = S.reverse . S.reverseScanr f z . reverseStream
+{-# INLINE scanr #-}
+
+shorten n t@(S.Stream arr off len) | n < len && n > 0 = S.Stream arr off n
+                                   | otherwise        = t
+info (S.Stream _ _ len) = len
+
 -- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a
 -- function to each element of a 'Text', passing an accumulating
 -- parameter from left to right, and returns a final 'Text'.

Data/Text/UnsafeChar.hs

     , unsafeChr8
     , unsafeChr32
     , unsafeWrite
+    , unsafeWriteRev
     ) where
 
+import Control.Exception (assert)
 import Control.Monad.ST (ST)
 import Data.Bits ((.&.), shiftR)
 import Data.Char (ord)
 unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int
 unsafeWrite marr i c
     | n < 0x10000 = do
-        A.unsafeWrite marr i (fromIntegral n)
+        assert (i >= 0) . assert (i < A.length marr) $
+          A.unsafeWrite marr i (fromIntegral n)
         return (i+1)
     | otherwise = do
-        A.unsafeWrite marr i     l
-        A.unsafeWrite marr (i+1) r
+        assert (i >= 0) . assert (i < A.length marr - 1) $
+          A.unsafeWrite marr i lo
+        A.unsafeWrite marr (i+1) hi
         return (i+2)
     where n = ord c
           m = n - 0x10000
-          l = fromIntegral $ (m `shiftR` 10) + 0xD800
-          r = fromIntegral $ (m .&. 0x3FF) + 0xDC00
+          lo = fromIntegral $ (m `shiftR` 10) + 0xD800
+          hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
 {-# INLINE unsafeWrite #-}
+
+unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int
+unsafeWriteRev marr i c
+    | n < 0x10000 = do
+        assert (i >= 0) . assert (i < A.length marr) $
+          A.unsafeWrite marr i (fromIntegral n)
+        return (i-1)
+    | otherwise = do
+        assert (i >= 1) . assert (i < A.length marr) $
+          A.unsafeWrite marr (i-1) lo
+        A.unsafeWrite marr i hi
+        return (i-2)
+    where n = ord c
+          m = n - 0x10000
+          lo = fromIntegral $ (m `shiftR` 10) + 0xD800
+          hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
+{-# INLINE unsafeWriteRev #-}

tests/Properties.hs

 import qualified Data.Text as T
 import Data.Text (pack,unpack)
 import qualified Data.Text.Fusion as S
-import Data.Text.Fusion (unstream,stream)
+import Data.Text.Fusion (stream, unstream)
 import qualified Data.List as L
 
 
 
 prop_pack_unpack s   = (unpack . pack) s == s
 prop_stream_unstream t = (unstream . stream) t == t
+prop_reverse_stream t = (S.reverse . S.reverseStream) t == t
 prop_singleton c     = [c] == (unpack . T.singleton) c
 
 -- Do two functions give the same answer?
 eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool
 eq a b s  = a s == b s
 -- What about with the RHS packed?
-eqP :: (Eq a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool
-eqP a b s w  = a s == b t &&
-               a sa == b ta &&
-               a sb == b tb
+eqP :: (Eq a, Show a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool
+eqP a b s w  = eq "orig" (a s) (b t) &&
+               eq "head" (a sa) (b ta) &&
+               eq "tail" (a sb) (b tb)
     where t             = pack s
           (sa,sb)       = splitAt m s
           (ta,tb)       = T.splitAt m t
           m | l == 0    = n
             | otherwise = n `mod` l
           n             = fromIntegral w
+          eq s a b | a == b = True
+                   | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False
 -- Or with the string non-empty, and the RHS packed?
 eqEP :: (Eq a) =>
         (String -> a) -> (T.Text -> a) -> NotEmpty String -> Word8 -> Bool
 prop_intersperse c   = L.intersperse c `eqP` (unpack . T.intersperse c)
 prop_transpose       = L.transpose `eq` (map unpack . T.transpose . map pack)
 prop_reverse         = L.reverse `eqP` (unpack . T.reverse)
+prop_reverse_short n = L.reverse `eqP` (unpack . S.reverse . shorten n . stream)
 
 prop_foldl f z       = L.foldl f z  `eqP`  (T.foldl f z)
     where types      = f :: Char -> Char -> Char
 
 prop_scanl f z       = L.scanl f z   `eqP`  (unpack . T.scanl f z)
 prop_scanl1 f        = L.scanl1 f    `eqP`  (unpack . T.scanl1 f)
+prop_scanr f z       = L.scanr f z   `eqP`  (unpack . T.scanr f z)
 
 prop_mapAccumL f z   = (snd . L.mapAccumL f z)`eqP` (unpack . T.mapAccumL f z)
     where types = f :: Int -> Char -> (Int,Char)
 prop_count c         = (L.length . L.elemIndices c) `eqP` T.count c
 prop_zipWith c s     = L.zipWith c s `eqP` (unpack . T.zipWith c (pack s))
 
+-- Make a stream appear shorter than it really is, to ensure that
+-- functions that consume inaccurately sized streams behave
+-- themselves.
+shorten :: Int -> S.Stream a -> S.Stream a
+shorten n t@(S.Stream arr off len)
+    | n < len && n > 0 = S.Stream arr off n
+    | otherwise        = t
+
 main = run tests =<< getArgs
 
 run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()
 tests = [
   ("prop_pack_unpack", mytest prop_pack_unpack),
   ("prop_stream_unstream", mytest prop_stream_unstream),
+  ("prop_reverse_stream", mytest prop_reverse_stream),
   ("prop_singleton", mytest prop_singleton),
 
   ("prop_cons", mytest prop_cons),
   ("prop_intersperse", mytest prop_intersperse),
   ("prop_transpose", mytest prop_transpose),
   ("prop_reverse", mytest prop_reverse),
+  ("prop_reverse_short", mytest prop_reverse_short),
 
   ("prop_foldl", mytest prop_foldl),
   ("prop_foldl'", mytest prop_foldl'),
 
   ("prop_scanl", mytest prop_scanl),
   ("prop_scanl1", mytest prop_scanl1),
+  ("prop_scanr", mytest prop_scanr),
 
   ("prop_mapAccumL", mytest prop_mapAccumL),
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.