cfb8278 · text · git.iko.soy

git.iko.soy/text

Fix size hints

This fixes a variety of size hint bugs in text's fusion framework. These issues fell broadly into two classes, * Code point/code unit confusion * Inappropriate bounds It seems the most of the latter were introduced when the Size type was extended to track both upper and lower bounds in f4fc30c. These could manifest in a variety of issues similar to #197.

commitcfb82784fb16e982960619af4187e83b07ac3fb2 authorBen Gamari <ben@smart-cactus.org> dateFri 8 Sep 2017, 19:42 (9 years ago) parentc91deda

2 files changed+60−28

compare with master

unifiedsplit

Data/Text/Internal/Fusion/Common.hs+28−22 Data/Text/Internal/Fusion/Size.hs+32−6

Data/Text/Internal/Fusion/Common.hs+28−22

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}

1+{-# LANGUAGE PatternGuards, BangPatterns, MagicHash, Rank2Types #-}

22-- |

33-- Module : Data.Text.Internal.Fusion.Common

44-- Copyright : (c) Bryan O'Sullivan 2009, 2012

@@ -117,7 +117,7 @@ import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

117117import GHC.Types (Char(..), Int(..))

118118

119119singleton :: Char -> Stream Char

120−singleton c = Stream next False 1

120+singleton c = Stream next False (codePointsSize 1)

121121 where next False = Yield c True

122122 next True = Done

123123{-# INLINE [0] singleton #-}

@@ -175,7 +175,7 @@ data C s = C0 !s

175175

176176-- | /O(n)/ Adds a character to the front of a Stream Char.

177177cons :: Char -> Stream Char -> Stream Char

178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len + codePointsSize 1)

179179 where

180180 next (C1 s) = Yield w (C0 s)

181181 next (C0 s) = case next0 s of

@@ -189,7 +189,7 @@ data Snoc a = N

189189

190190-- | /O(n)/ Adds a character to the end of a stream.

191191snoc :: Stream Char -> Char -> Stream Char

192−snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len + codePointsSize 1)

193193 where

194194 next (J xs) = case next0 xs of

195195 Done -> Yield w N

@@ -237,7 +237,7 @@ uncons :: Stream Char -> Maybe (Char, Stream Char)

237237uncons (Stream next s0 len) = loop_uncons s0

238238 where

239239 loop_uncons !s = case next s of

240− Yield x s1 -> Just (x, Stream next s1 (len-1))

240+ Yield x s1 -> Just (x, Stream next s1 (len - codePointsSize 1))

241241 Skip s' -> loop_uncons s'

242242 Done -> Nothing

243243{-# INLINE [0] uncons #-}

@@ -260,7 +260,7 @@ last (Stream next s0 _len) = loop0_last s0

260260-- | /O(1)/ Returns all characters after the head of a Stream Char, which must

261261-- be non-empty.

262262tail :: Stream Char -> Stream Char

263−tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)

263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len - codePointsSize 1)

264264 where

265265 next (C0 s) = case next0 s of

266266 Done -> emptyError "tail"

@@ -278,7 +278,7 @@ data Init s = Init0 !s

278278-- | /O(1)/ Returns all but the last character of a Stream Char, which

279279-- must be non-empty.

280280init :: Stream Char -> Stream Char

281−init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)

281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len - codePointsSize 1)

282282 where

283283 next (Init0 s) = case next0 s of

284284 Done -> emptyError "init"

@@ -318,11 +318,14 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

318318-- greater than the number or if the stream can't possibly be as long

319319-- as the number supplied, and hence be more efficient.

320320compareLengthI :: Integral a => Stream Char -> a -> Ordering

321−compareLengthI (Stream next s0 len) n =

322− case compareSize len (fromIntegral n) of

323− Just o -> o

324− Nothing -> loop_cmp 0 s0

321+compareLengthI (Stream next s0 len) n

322+ -- Note that @len@ tracks code units whereas we want to compare the length

323+ -- in code points. Specifically, a stream with hint @len@ may consist of

324+ -- anywhere from @len/2@ to @len@ code points.

325+ | Just r <- compareSize len n' = r

326+ | otherwise = loop_cmp 0 s0

325327 where

328+ n' = codePointsSize $ fromIntegral n

326329 loop_cmp !z s = case next s of

327330 Done -> compare z n

328331 Skip s' -> loop_cmp z s'

@@ -368,7 +371,7 @@ data I s = I1 !s

368371-- | /O(n)/ Take a character and place it between each of the

369372-- characters of a 'Stream Char'.

370373intersperse :: Char -> Stream Char -> Stream Char

371−intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

374+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) (len + unknownSize)

372375 where

373376 next (I1 s) = case next0 s of

374377 Done -> Done

@@ -393,9 +396,11 @@ intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

393396-- functions may map one input character to two or three output

394397-- characters.

395398

399+-- | Map a 'Stream' through the given case-mapping function.

396400caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

397401 -> Stream Char -> Stream Char

398−caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len

402+caseConvert remap (Stream next0 s0 len) =

403+ Stream next (CC s0 '\0' '\0') (len `unionSize` 3*len)

399404 where

400405 next (CC s '\0' _) =

401406 case next0 s of

@@ -458,7 +463,7 @@ toLower = caseConvert lowerMapping

458463-- Fox\" is correctly title cased—but this function will

459464-- capitalize /every/ word.

460465toTitle :: Stream Char -> Stream Char

461−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

466+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') (len + unknownSize)

462467 where

463468 next (CC (letter :*: s) '\0' _) =

464469 case next0 s of

@@ -479,7 +484,7 @@ data Justify i s = Just1 !i !s

479484

480485justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

481486justifyLeftI k c (Stream next0 s0 len) =

482− Stream next (Just1 0 s0) (larger (fromIntegral k) len)

487+ Stream next (Just1 0 s0) (larger (fromIntegral k * charSize c + len) len)

483488 where

484489 next (Just1 n s) =

485490 case next0 s of

@@ -699,7 +704,7 @@ replicateI n (Stream next0 s0 len) =

699704-- (a,b), in which case, a is the next Char in the string, and b is

700705-- the seed value for further production.

701706unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char

702−unfoldr f s0 = Stream next s0 1 -- HINT maybe too low

707+unfoldr f s0 = Stream next s0 unknownSize

703708 where

704709 {-# INLINE next #-}

705710 next !s = case f s of

@@ -713,7 +718,7 @@ unfoldr f s0 = Stream next s0 1 -- HINT maybe too low

713718-- 'unfoldr' when the length of the result is known.

714719unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

715720unfoldrNI n f s0 | n < 0 = empty

716− | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high

721+ | otherwise = Stream next (0 :*: s0) (maxSize $ fromIntegral (n*2))

717722 where

718723 {-# INLINE next #-}

719724 next (z :*: s) = case f s of

@@ -730,7 +735,7 @@ unfoldrNI n f s0 | n < 0 = empty

730735-- length of the stream.

731736take :: Integral a => a -> Stream Char -> Stream Char

732737take n0 (Stream next0 s0 len) =

733− Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))

738+ Stream next (n0 :*: s0) (smaller len (codePointsSize $ fromIntegral n0))

734739 where

735740 {-# INLINE next #-}

736741 next (n :*: s) | n <= 0 = Done

@@ -748,7 +753,7 @@ data Drop a s = NS !s

748753-- is greater than the length of the stream.

749754drop :: Integral a => a -> Stream Char -> Stream Char

750755drop n0 (Stream next0 s0 len) =

751− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

756+ Stream next (JS n0 s0) (len - codePointsSize (fromIntegral n0))

752757 where

753758 {-# INLINE next #-}

754759 next (JS n s)

@@ -766,7 +771,7 @@ drop n0 (Stream next0 s0 len) =

766771-- | takeWhile, applied to a predicate @p@ and a stream, returns the

767772-- longest prefix (possibly empty) of elements that satisfy p.

768773takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char

769−takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

774+takeWhile p (Stream next0 s0 len) = Stream next s0 (len - unknownSize)

770775 where

771776 {-# INLINE next #-}

772777 next !s = case next0 s of

@@ -778,7 +783,7 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

778783

779784-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

780785dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

781−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

786+dropWhile p (Stream next0 s0 len) = Stream next (L s0) (len - unknownSize)

782787 where

783788 {-# INLINE next #-}

784789 next (L s) = case next0 s of

@@ -857,7 +862,8 @@ indexI (Stream next s0 _len) n0

857862-- returns a stream containing those characters that satisfy the

858863-- predicate.

859864filter :: (Char -> Bool) -> Stream Char -> Stream Char

860−filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

865+filter p (Stream next0 s0 len) =

866+ Stream next s0 (len - unknownSize) -- HINT maybe too high

861867 where

862868 next !s = case next0 s of

863869 Done -> Done

Data/Text/Internal/Fusion/Size.hs+32−6

@@ -19,11 +19,16 @@

1919module Data.Text.Internal.Fusion.Size

2020 (

2121 Size

22− , exactly

22+ -- * Sizes

2323 , exactSize

2424 , maxSize

2525 , betweenSize

2626 , unknownSize

27+ , unionSize

28+ , charSize

29+ , codePointsSize

30+ -- * Querying sizes

31+ , exactly

2732 , smaller

2833 , larger

2934 , upperBound

@@ -32,11 +37,13 @@ module Data.Text.Internal.Fusion.Size

3237 , isEmpty

3338 ) where

3439

40+import Data.Char (ord)

3541import Data.Text.Internal (mul)

3642#if defined(ASSERTS)

3743import Control.Exception (assert)

3844#endif

3945

46+-- | A size in UTF-16 code units.

4047data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.

4148 | Unknown -- ^ Unknown size.

4249 deriving (Eq, Show)

@@ -46,6 +53,17 @@ exactly (Between na nb) | na == nb = Just na

4653exactly _ = Nothing

4754{-# INLINE exactly #-}

4855

56+-- | The 'Size' of the given code point.

57+charSize :: Char -> Size

58+charSize c

59+ | ord c < 0x10000 = exactSize 1

60+ | otherwise = exactSize 2

61+

62+-- | The 'Size' of @n@ code points.

63+codePointsSize :: Int -> Size

64+codePointsSize n = Between n (2*n)

65+{-# INLINE codePointsSize #-}

66+

4967exactSize :: Int -> Size

5068exactSize n =

5169#if defined(ASSERTS)

@@ -71,6 +89,10 @@ betweenSize m n =

7189 Between m n

7290{-# INLINE betweenSize #-}

7391

92+unionSize :: Size -> Size -> Size

93+unionSize (Between a b) (Between c d) = Between (min a c) (max b d)

94+unionSize _ _ = Unknown

95+

7496unknownSize :: Size

7597unknownSize = Unknown

7698{-# INLINE unknownSize #-}

@@ -140,11 +162,15 @@ lowerBound _ (Between n _) = n

140162lowerBound k _ = k

141163{-# INLINE lowerBound #-}

142164

143−compareSize :: Size -> Int -> Maybe Ordering

144−compareSize (Between ma mb) n

145− | mb < n = Just LT

146− | ma > n = Just GT

147− | ma == n && mb == n = Just EQ

165+-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in

166+-- the indeterminate case.

167+compareSize :: Size -> Size -> Maybe Ordering

168+compareSize (Between ma mb) (Between na nb)

169+ | mb < na = Just LT

170+ | ma > nb = Just GT

171+ | ma == mb

172+ , ma == na

173+ , ma == nb = Just EQ

148174compareSize _ _ = Nothing

149175

150176