Tracking both upper and lower bounds in Size

Data/Text/Internal/Fusion.hs

@@ -51,7 +51,7 @@ module Data.Text.Internal.Fusion
 
 import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
                 Num(..), Ord(..), ($), (&&),
-                fromIntegral, otherwise)
+                fromIntegral, otherwise, quot)
 import Data.Bits ((.&.))
 import Data.Text.Internal (Text(..))
 import Data.Text.Internal.Private (runText)
@@ -68,7 +68,7 @@ default(Int)
 
 -- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
 stream :: Text -> Stream Char
-stream (Text arr off len) = Stream next off (maxSize len)
+stream (Text arr off len) = Stream next off (betweenSize (len `quot` 2) len)
     where
       !end = off+len
       next !i
@@ -83,7 +83,7 @@ stream (Text arr off len) = Stream next off (maxSize len)
 -- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
 -- backwards.
 reverseStream :: Text -> Stream Char
-reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `quot` 2) len)
     where
       {-# INLINE next #-}
       next !i

Data/Text/Internal/Fusion/Common.hs

@@ -321,8 +321,10 @@ compareLengthI :: Integral a => Stream Char -> a -> Ordering
 compareLengthI (Stream next s0 len) n =
     case exactly len of
       Nothing
-        | upperBound (fromIntegral n) len < (fromIntegral n) -> LT
+        | upperBound n' len < n' -> LT
+        | lowerBound n' len > n' -> GT
         | otherwise -> loop_cmp 0 s0
+        where n' = fromIntegral n
       Just i -> compare (fromIntegral i) n
     where
       loop_cmp !z s  = case next s of

Data/Text/Internal/Fusion/Size.hs

@@ -22,43 +22,53 @@ module Data.Text.Internal.Fusion.Size
     , exactly
     , exactSize
     , maxSize
+    , betweenSize
     , unknownSize
     , smaller
     , larger
     , upperBound
+    , lowerBound
     , isEmpty
     ) where
 
 #if defined(ASSERTS)
 import Control.Exception (assert)
 #endif
 
-data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.
-          | Max   {-# UNPACK #-} !Int -- ^ Upper bound on size.
-          | Unknown                   -- ^ Unknown size.
+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
+          | Unknown                                         -- ^ Unknown size.
             deriving (Eq, Show)
 
 exactly :: Size -> Maybe Int
-exactly (Exact n) = Just n
-exactly _         = Nothing
+exactly (Between na nb) | na == nb = Just na
+exactly _ = Nothing
 {-# INLINE exactly #-}
 
 exactSize :: Int -> Size
 exactSize n =
 #if defined(ASSERTS)
     assert (n >= 0)
 #endif
-    Exact n
+    Between n n
 {-# INLINE exactSize #-}
 
 maxSize :: Int -> Size
 maxSize n =
 #if defined(ASSERTS)
     assert (n >= 0)
 #endif
-    Max n
+    Between 0 n
 {-# INLINE maxSize #-}
 
+betweenSize :: Int -> Int -> Size
+betweenSize m n =
+#if defined(ASSERTS)
+    assset (m >= 0)
+    assert (n >= m)
+#endif
+    Between m n
+{-# INLINE betweenSize #-}
+
 unknownSize :: Size
 unknownSize = Unknown
 {-# INLINE unknownSize #-}
@@ -68,7 +78,7 @@ instance Num Size where
     (-) = subtractSize
     (*) = mulSize
 
-    fromInteger = f where f = Exact . fromInteger
+    fromInteger = f where f = exactSize . fromInteger
                           {-# INLINE f #-}
 
 add :: Int -> Int -> Int
@@ -78,20 +88,15 @@ add m n | mn >=   0 = mn
 {-# INLINE add #-}
 
 addSize :: Size -> Size -> Size
-addSize (Exact m) (Exact n) = Exact (add m n)
-addSize (Exact m) (Max   n) = Max   (add m n)
-addSize (Max   m) (Exact n) = Max   (add m n)
-addSize (Max   m) (Max   n) = Max   (add m n)
-addSize _          _       = Unknown
+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)
+addSize _               _               = Unknown
 {-# INLINE addSize #-}
 
 subtractSize :: Size -> Size -> Size
-subtractSize   (Exact m) (Exact n) = Exact (max (m-n) 0)
-subtractSize   (Exact m) (Max   _) = Max   m
-subtractSize   (Max   m) (Exact n) = Max   (max (m-n) 0)
-subtractSize a@(Max   _) (Max   _) = a
-subtractSize a@(Max   _) Unknown   = a
-subtractSize _         _           = Unknown
+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)
+subtractSize a@(Between 0 _) Unknown         = a
+subtractSize (Between _ mb)  Unknown         = Between 0 mb
+subtractSize _               _               = Unknown
 {-# INLINE subtractSize #-}
 
 mul :: Int -> Int -> Int
@@ -101,48 +106,47 @@ mul m n
 {-# INLINE mul #-}
 
 mulSize :: Size -> Size -> Size
-mulSize (Exact m) (Exact n) = Exact (mul m n)
-mulSize (Exact m) (Max   n) = Max   (mul m n)
-mulSize (Max   m) (Exact n) = Max   (mul m n)
-mulSize (Max   m) (Max   n) = Max   (mul m n)
-mulSize _          _        = Unknown
+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
+mulSize _               _               = Unknown
 {-# INLINE mulSize #-}
 
 -- | Minimum of two size hints.
 smaller :: Size -> Size -> Size
-smaller   (Exact m) (Exact n) = Exact (m `min` n)
-smaller   (Exact m) (Max   n) = Max   (m `min` n)
-smaller   (Exact m) Unknown   = Max   m
-smaller   (Max   m) (Exact n) = Max   (m `min` n)
-smaller   (Max   m) (Max   n) = Max   (m `min` n)
-smaller a@(Max   _) Unknown   = a
-smaller   Unknown   (Exact n) = Max   n
-smaller   Unknown   (Max   n) = Max   n
-smaller   Unknown   Unknown   = Unknown
+smaller a@(Between ma mb) b@(Between na nb)
+    | mb <= na  = a
+    | nb <= ma  = b
+    | otherwise = Between (ma `min` na) (mb `min` nb)
+smaller a@(Between 0 _) Unknown         = a
+smaller (Between _ mb)  Unknown         = Between 0 mb
+smaller Unknown         b@(Between 0 _) = b
+smaller Unknown         (Between _ nb)  = Between 0 nb
+smaller Unknown         Unknown         = Unknown
 {-# INLINE smaller #-}
 
 -- | Maximum of two size hints.
 larger :: Size -> Size -> Size
-larger   (Exact m)   (Exact n)             = Exact (m `max` n)
-larger a@(Exact m) b@(Max   n) | m >= n    = a
-                               | otherwise = b
-larger a@(Max   m) b@(Exact n) | n >= m    = b
-                               | otherwise = a
-larger   (Max   m)   (Max   n)             = Max   (m `max` n)
-larger _             _                     = Unknown
+larger a@(Between ma mb) b@(Between na nb)
+    | ma >= nb  = a
+    | na >= mb  = b
+    | otherwise = Between (ma `max` na) (mb `max` nb)
+larger _ _ = Unknown
 {-# INLINE larger #-}
 
 -- | Compute the maximum size from a size hint, if possible.
 upperBound :: Int -> Size -> Int
-upperBound _ (Exact n) = n
-upperBound _ (Max   n) = n
-upperBound k _         = k
+upperBound _ (Between n _) = n
+upperBound k _             = k
 {-# INLINE upperBound #-}
 
+-- | Compute the maximum size from a size hint, if possible.
+lowerBound :: Int -> Size -> Int
+lowerBound _ (Between n _) = n
+lowerBound k _             = k
+{-# INLINE lowerBound #-}
+
 isEmpty :: Size -> Bool
-isEmpty (Exact n) = n <= 0
-isEmpty (Max   n) = n <= 0
-isEmpty _         = False
+isEmpty (Between _ n) = n <= 0
+isEmpty _             = False
 {-# INLINE isEmpty #-}
 
 overflowError :: Int