Bryan O'Sullivan avatar Bryan O'Sullivan committed f43a5f0

Expose and fix some subtle bugs.

Comments (0)

Files changed (4)

Data/Text/Fusion.hs

 import Data.Char (ord)
 import Data.Text.Internal (Text(..))
 import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
-import Data.Text.UnsafeShift (shiftR)
+import Data.Text.UnsafeShift (shiftL, shiftR)
 import qualified Data.Text.Array as A
 import qualified Data.Text.Fusion.Common as S
 import Data.Text.Fusion.Internal
 
 -- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
 unstream :: Stream Char -> Text
-unstream (Stream next0 s0 len)
-    | isEmpty len = I.empty
-    | otherwise   = I.textP (P.fst a) 0 (P.snd a)
+unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)
     where
       mlen = upperBound 4 len
       a = A.run2 (A.unsafeNew mlen >>= (\arr -> loop arr mlen s0 0))
           | i + 1 >= top = case next0 s of
                             Done -> return (arr, i)
                             _    -> do
-                              arr' <- A.unsafeNew (top*2)
-                              A.copy arr arr' >> loop arr' (top*2) s i
+                              let top' = (top `shiftL` 1) + 1
+                              arr' <- A.unsafeNew top'
+                              A.copy arr arr' >> loop arr' top' s i
           | otherwise = case next0 s of
                Done       -> return (arr, i)
                Skip s'    -> loop arr top s' i

Data/Text/Fusion/Common.hs

 
 streamList :: [a] -> Stream a
 {-# INLINE [0] streamList #-}
-streamList [] = empty
 streamList s  = Stream next s unknownSize
     where next []       = Done
           next (x:xs)   = Yield x xs
     where
       {-# INLINE next #-}
       next (False :!: s) = case next0 s of
-                          Done -> emptyError "tail"
-                          Skip s' -> Skip (False :!: s')
+                          Done       -> emptyError "tail"
+                          Skip s'    -> Skip (False :!: s')
                           Yield _ s' -> Skip (True :!: s')
       next (True :!: s) = case next0 s of
-                          Done -> Done
-                          Skip s' -> Skip (True :!: s')
+                          Done       -> Done
+                          Skip s'    -> Skip    (True :!: s')
                           Yield x s' -> Yield x (True :!: s')
 {-# INLINE [0] tail #-}
 

Data/Text/Fusion/Internal.hs

               | Skip !s
               | Yield !a !s
 
-{-
-instance Show a => Show (Step s a)
+instance (Show a) => Show (Step s a)
     where show Done        = "Done"
           show (Skip _)    = "Skip"
           show (Yield x _) = "Yield " ++ show x
--}
 
 instance (Eq a) => Eq (Stream a) where
     (==) = eq

tests/Properties.hs

 t_snoc x          = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
 tl_snoc x         = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
 s_append s        = (s++)    `eqP` (unpackS . S.append (S.streamList s))
+s_append_s s      = (s++)    `eqP` (unpackS . S.unstream . S.append (S.streamList s))
 sf_append p s     = (L.filter p s++) `eqP` (unpackS . S.append (S.filter p $ S.streamList s))
 t_append s        = (s++)    `eqP` (unpackS . T.append (packS s))
 
 t_last            = last   `eqP` T.last
 tl_last           = last   `eqP` TL.last
 s_tail            = tail   `eqP` (unpackS . S.tail)
+s_tail_s          = tail   `eqP` (unpackS . S.unstream . S.tail)
 sf_tail p         = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)
 t_tail            = tail   `eqP` (unpackS . T.tail)
 tl_tail           = tail   `eqP` (unpackS . TL.tail)
     testProperty "t_snoc" t_snoc,
     testProperty "tl_snoc" tl_snoc,
     testProperty "s_append" s_append,
+    testProperty "s_append_s" s_append_s,
     testProperty "sf_append" sf_append,
     testProperty "t_append" t_append,
     testProperty "s_uncons" s_uncons,
     testProperty "t_last" t_last,
     testProperty "tl_last" tl_last,
     testProperty "s_tail" s_tail,
+    testProperty "s_tail_s" s_tail_s,
     testProperty "sf_tail" sf_tail,
     testProperty "t_tail" t_tail,
     testProperty "tl_tail" tl_tail,
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.