From 874c3164fadf39a83382359d2b6ce941a3e134da Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Mon, 21 Jun 2021 18:48:01 +0100 Subject: [PATCH] Disable implicit fusion rules (#348) A cherry-pick of https://github.com/haskell/text/pull/348 onto 1.2.3.2, with some quick conflict fixes --- Data/Text.hs | 208 +++++++------------------ Data/Text/Encoding.hs | 2 - Data/Text/Internal/Fusion/Common.hs | 7 +- Data/Text/Lazy.hs | 226 ++++++---------------------- Data/Text/Lazy/Encoding.hs | 4 - Data/Text/Show.hs | 10 +- changelog.md | 3 + tests/Tests.hs | 6 +- text.cabal | 101 ------------- 9 files changed, 121 insertions(+), 446 deletions(-) diff --git a/Data/Text.hs b/Data/Text.hs index 039cc487..5d3dda91 100644 --- a/Data/Text.hs +++ b/Data/Text.hs @@ -312,28 +312,11 @@ import Text.Printf (PrintfArg, formatArg, formatString) -- $fusion -- --- Most of the functions in this module are subject to /fusion/, --- meaning that a pipeline of such functions will usually allocate at --- most one 'Text' value. --- --- As an example, consider the following pipeline: --- --- > import Data.Text as T --- > import Data.Text.Encoding as E --- > import Data.ByteString (ByteString) --- > --- > countChars :: ByteString -> Int --- > countChars = T.length . T.toUpper . E.decodeUtf8 --- --- From the type signatures involved, this looks like it should --- allocate one 'Data.ByteString.ByteString' value, and two 'Text' --- values. However, when a module is compiled with optimisation --- enabled under GHC, the two intermediate 'Text' values will be --- optimised away, and the function will be compiled down to a single --- loop over the source 'Data.ByteString.ByteString'. --- --- Functions that can be fused by the compiler are documented with the --- phrase \"Subject to fusion\". +-- Starting from @text-1.3@ fusion is no longer implicit, +-- and pipelines of transormations usually allocate intermediate 'Text' values. +-- Users, who observe significant changes to performances, +-- are encouraged to use fusion framework explicitly, employing +-- "Data.Text.Internal.Fusion" and "Data.Text.Internal.Fusion.Common". instance Eq Text where Text arrA offA lenA == Text arrB offB lenB @@ -444,8 +427,8 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB) -- ----------------------------------------------------------------------------- -- * Conversion to/from 'Text' --- | /O(n)/ Convert a 'String' into a 'Text'. Subject to --- fusion. Performs replacement on invalid scalar values. +-- | /O(n)/ Convert a 'String' into a 'Text'. +-- Performs replacement on invalid scalar values. pack :: String -> Text pack = unstream . S.map safe . S.streamList {-# INLINE [1] pack #-} @@ -455,7 +438,7 @@ pack = unstream . S.map safe . S.streamList -- | /O(n)/ Adds a character to the front of a 'Text'. This function -- is more costly than its 'List' counterpart because it requires --- copying a new array. Subject to fusion. Performs replacement on +-- copying a new array. Performs replacement on -- invalid scalar values. cons :: Char -> Text -> Text cons c t = unstream (S.cons (safe c) (stream t)) @@ -464,14 +447,14 @@ cons c t = unstream (S.cons (safe c) (stream t)) infixr 5 `cons` -- | /O(n)/ Adds a character to the end of a 'Text'. This copies the --- entire array in the process, unless fused. Subject to fusion. +-- entire array in the process. -- Performs replacement on invalid scalar values. snoc :: Text -> Char -> Text snoc t c = unstream (S.snoc (stream t) (safe c)) {-# INLINE snoc #-} -- | /O(n)/ Appends one 'Text' to the other by copying both of them --- into a new 'Text'. Subject to fusion. +-- into a new 'Text'. append :: Text -> Text -> Text append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2) | len1 == 0 = b @@ -488,21 +471,14 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2) return arr {-# NOINLINE append #-} -{-# RULES -"TEXT append -> fused" [~1] forall t1 t2. - append t1 t2 = unstream (S.append (stream t1) (stream t2)) -"TEXT append -> unfused" [1] forall t1 t2. - unstream (S.append (stream t1) (stream t2)) = append t1 t2 - #-} - -- | /O(1)/ Returns the first character of a 'Text', which must be --- non-empty. Subject to fusion. +-- non-empty. head :: Text -> Char head t = S.head (stream t) {-# INLINE head #-} -- | /O(1)/ Returns the first character and rest of a 'Text', or --- 'Nothing' if empty. Subject to fusion. +-- 'Nothing' if empty. uncons :: Text -> Maybe (Char, Text) uncons t@(Text arr off len) | len <= 0 = Nothing @@ -515,7 +491,7 @@ second :: (b -> c) -> (a,b) -> (a,c) second f (a, b) = (a, f b) -- | /O(1)/ Returns the last character of a 'Text', which must be --- non-empty. Subject to fusion. +-- non-empty. last :: Text -> Char last (Text arr off len) | len <= 0 = emptyError "last" @@ -525,15 +501,8 @@ last (Text arr off len) n0 = A.unsafeIndex arr (off+len-2) {-# INLINE [1] last #-} -{-# RULES -"TEXT last -> fused" [~1] forall t. - last t = S.last (stream t) -"TEXT last -> unfused" [1] forall t. - S.last (stream t) = last t - #-} - -- | /O(1)/ Returns all characters after the head of a 'Text', which --- must be non-empty. Subject to fusion. +-- must be non-empty. tail :: Text -> Text tail t@(Text arr off len) | len <= 0 = emptyError "tail" @@ -541,15 +510,8 @@ tail t@(Text arr off len) where d = iter_ t 0 {-# INLINE [1] tail #-} -{-# RULES -"TEXT tail -> fused" [~1] forall t. - tail t = unstream (S.tail (stream t)) -"TEXT tail -> unfused" [1] forall t. - unstream (S.tail (stream t)) = tail t - #-} - -- | /O(1)/ Returns all but the last character of a 'Text', which must --- be non-empty. Subject to fusion. +-- be non-empty. init :: Text -> Text init (Text arr off len) | len <= 0 = emptyError "init" | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2) @@ -558,13 +520,6 @@ init (Text arr off len) | len <= 0 = emptyError "init" n = A.unsafeIndex arr (off+len-1) {-# INLINE [1] init #-} -{-# RULES -"TEXT init -> fused" [~1] forall t. - init t = unstream (S.init (stream t)) -"TEXT init -> unfused" [1] forall t. - unstream (S.init (stream t)) = init t - #-} - -- | /O(1)/ Returns all but the last character and the last character of a -- 'Text', or 'Nothing' if empty. -- @@ -578,8 +533,7 @@ unsnoc (Text arr off len) n0 = A.unsafeIndex arr (off+len-2) {-# INLINE [1] unsnoc #-} --- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to --- fusion. +-- | /O(1)/ Tests whether a 'Text' is empty or not. null :: Text -> Bool null (Text _arr _off len) = #if defined(ASSERTS) @@ -588,29 +542,23 @@ null (Text _arr _off len) = len <= 0 {-# INLINE [1] null #-} -{-# RULES -"TEXT null -> fused" [~1] forall t. - null t = S.null (stream t) -"TEXT null -> unfused" [1] forall t. - S.null (stream t) = null t - #-} - -- | /O(1)/ Tests whether a 'Text' contains exactly one character. --- Subject to fusion. isSingleton :: Text -> Bool isSingleton = S.isSingleton . stream {-# INLINE isSingleton #-} -- | /O(n)/ Returns the number of characters in a 'Text'. --- Subject to fusion. -length :: Text -> Int +length :: +#if defined(ASSERTS) + HasCallStack => +#endif + Text -> Int length t = S.length (stream t) {-# INLINE [0] length #-} -- length needs to be phased after the compareN/length rules otherwise -- it may inline before the rules have an opportunity to fire. -- | /O(n)/ Compare the count of characters in a 'Text' to a number. --- Subject to fusion. -- -- This function gives the same answer as comparing against the result -- of 'length', but can short circuit if the count of characters is @@ -665,7 +613,7 @@ compareLength t n = S.compareLengthI (stream t) n -- >>> T.map (\c -> if c == '.' then '!' else c) message -- "I am not angry! Not at all!" -- --- Subject to fusion. Performs replacement on invalid scalar values. +-- Performs replacement on invalid scalar values. map :: (Char -> Char) -> Text -> Text map f t = unstream (S.map (safe . f) (stream t)) {-# INLINE [1] map #-} @@ -690,7 +638,7 @@ intercalate t = concat . (F.intersperse t) -- >>> T.intersperse '.' "SHIELD" -- "S.H.I.E.L.D" -- --- Subject to fusion. Performs replacement on invalid scalar values. +-- Performs replacement on invalid scalar values. intersperse :: Char -> Text -> Text intersperse c t = unstream (S.intersperse (safe c) (stream t)) {-# INLINE intersperse #-} @@ -701,9 +649,11 @@ intersperse c t = unstream (S.intersperse (safe c) (stream t)) -- -- >>> T.reverse "desrever" -- "reversed" --- --- Subject to fusion. -reverse :: Text -> Text +reverse :: +#if defined(ASSERTS) + HasCallStack => +#endif + Text -> Text reverse t = S.reverse (stream t) {-# INLINE reverse #-} @@ -783,7 +733,7 @@ replace needle@(Text _ _ neeLen) -- sensitivity should use appropriate versions of the -- . --- | /O(n)/ Convert a string to folded case. Subject to fusion. +-- | /O(n)/ Convert a string to folded case. -- -- This function is mainly useful for performing caseless (also known -- as case insensitive) string comparisons. @@ -804,7 +754,7 @@ toCaseFold t = unstream (S.toCaseFold (stream t)) {-# INLINE toCaseFold #-} -- | /O(n)/ Convert a string to lower case, using simple case --- conversion. Subject to fusion. +-- conversion. -- -- The result string may be longer than the input string. For -- instance, \"İ\" (Latin capital letter I with dot above, @@ -815,7 +765,7 @@ toLower t = unstream (S.toLower (stream t)) {-# INLINE toLower #-} -- | /O(n)/ Convert a string to upper case, using simple case --- conversion. Subject to fusion. +-- conversion. -- -- The result string may be longer than the input string. For -- instance, the German \"ß\" (eszett, U+00DF) maps to the @@ -825,7 +775,7 @@ toUpper t = unstream (S.toUpper (stream t)) {-# INLINE toUpper #-} -- | /O(n)/ Convert a string to title case, using simple case --- conversion. Subject to fusion. +-- conversion. -- -- The first letter of the input is converted to title case, as is -- every subsequent letter that immediately follows a non-letter. @@ -849,7 +799,7 @@ toTitle t = unstream (S.toTitle (stream t)) {-# INLINE toTitle #-} -- | /O(n)/ Left-justify a string to the given length, using the --- specified fill character on the right. Subject to fusion. +-- specified fill character on the right. -- Performs replacement on invalid scalar values. -- -- Examples: @@ -866,13 +816,6 @@ justifyLeft k c t where len = length t {-# INLINE [1] justifyLeft #-} -{-# RULES -"TEXT justifyLeft -> fused" [~1] forall k c t. - justifyLeft k c t = unstream (S.justifyLeftI k c (stream t)) -"TEXT justifyLeft -> unfused" [1] forall k c t. - unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t - #-} - -- | /O(n)/ Right-justify a string to the given length, using the -- specified fill character on the left. Performs replacement on -- invalid scalar values. @@ -930,23 +873,22 @@ transpose ts = P.map pack (L.transpose (P.map unpack ts)) -- | /O(n)/ 'foldl', applied to a binary operator, a starting value -- (typically the left-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from left to right. --- Subject to fusion. foldl :: (a -> Char -> a) -> a -> Text -> a foldl f z t = S.foldl f z (stream t) {-# INLINE foldl #-} --- | /O(n)/ A strict version of 'foldl'. Subject to fusion. +-- | /O(n)/ A strict version of 'foldl'. foldl' :: (a -> Char -> a) -> a -> Text -> a foldl' f z t = S.foldl' f z (stream t) {-# INLINE foldl' #-} -- | /O(n)/ A variant of 'foldl' that has no starting value argument, --- and thus must be applied to a non-empty 'Text'. Subject to fusion. +-- and thus must be applied to a non-empty 'Text'. foldl1 :: (Char -> Char -> Char) -> Text -> Char foldl1 f t = S.foldl1 f (stream t) {-# INLINE foldl1 #-} --- | /O(n)/ A strict version of 'foldl1'. Subject to fusion. +-- | /O(n)/ A strict version of 'foldl1'. foldl1' :: (Char -> Char -> Char) -> Text -> Char foldl1' f t = S.foldl1' f (stream t) {-# INLINE foldl1' #-} @@ -954,14 +896,12 @@ foldl1' f t = S.foldl1' f (stream t) -- | /O(n)/ 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from right to left. --- Subject to fusion. foldr :: (Char -> a -> a) -> a -> Text -> a foldr f z t = S.foldr f z (stream t) {-# INLINE foldr #-} -- | /O(n)/ A variant of 'foldr' that has no starting value argument, --- and thus must be applied to a non-empty 'Text'. Subject to --- fusion. +-- and thus must be applied to a non-empty 'Text'. foldr1 :: (Char -> Char -> Char) -> Text -> Char foldr1 f t = S.foldr1 f (stream t) {-# INLINE foldr1 #-} @@ -992,25 +932,25 @@ concatMap f = concat . foldr ((:) . f) [] {-# INLINE concatMap #-} -- | /O(n)/ 'any' @p@ @t@ determines whether any character in the --- 'Text' @t@ satisfies the predicate @p@. Subject to fusion. +-- 'Text' @t@ satisfies the predicate @p@. any :: (Char -> Bool) -> Text -> Bool any p t = S.any p (stream t) {-# INLINE any #-} -- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the --- 'Text' @t@ satisfy the predicate @p@. Subject to fusion. +-- 'Text' @t@ satisfy the predicate @p@. all :: (Char -> Bool) -> Text -> Bool all p t = S.all p (stream t) {-# INLINE all #-} -- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which --- must be non-empty. Subject to fusion. +-- must be non-empty. maximum :: Text -> Char maximum t = S.maximum (stream t) {-# INLINE maximum #-} -- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which --- must be non-empty. Subject to fusion. +-- must be non-empty. minimum :: Text -> Char minimum t = S.minimum (stream t) {-# INLINE minimum #-} @@ -1019,7 +959,7 @@ minimum t = S.minimum (stream t) -- * Building 'Text's -- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of --- successive reduced values from the left. Subject to fusion. +-- successive reduced values from the left. -- Performs replacement on invalid scalar values. -- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] @@ -1107,7 +1047,7 @@ replicate n t@(Text a o l) #-} -- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the --- value of every element. Subject to fusion. +-- value of every element. replicateChar :: Int -> Char -> Text replicateChar n c = unstream (S.replicateCharI n (safe c)) {-# INLINE replicateChar #-} @@ -1117,8 +1057,8 @@ replicateChar n c = unstream (S.replicateCharI n (safe c)) -- 'Text' from a seed value. The function takes the element and -- returns 'Nothing' if it is done producing the 'Text', otherwise -- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the --- string, and @b@ is the seed value for further production. Subject --- to fusion. Performs replacement on invalid scalar values. +-- string, and @b@ is the seed value for further production. +-- Performs replacement on invalid scalar values. unfoldr :: (a -> Maybe (Char,a)) -> a -> Text unfoldr f s = unstream (S.unfoldr (firstf safe . f) s) {-# INLINE unfoldr #-} @@ -1127,8 +1067,8 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s) -- value. However, the length of the result should be limited by the -- first argument to 'unfoldrN'. This function is more efficient than -- 'unfoldr' when the maximum length of the result is known and --- correct, otherwise its performance is similar to 'unfoldr'. Subject --- to fusion. Performs replacement on invalid scalar values. +-- correct, otherwise its performance is similar to 'unfoldr'. +-- Performs replacement on invalid scalar values. unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s) {-# INLINE unfoldrN #-} @@ -1138,7 +1078,7 @@ unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s) -- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the -- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than --- the length of the Text. Subject to fusion. +-- the length of the Text. take :: Int -> Text -> Text take n t@(Text arr off len) | n <= 0 = empty @@ -1153,13 +1093,6 @@ iterN n t@(Text _arr _off len) = loop 0 0 | otherwise = loop (i+d) (cnt+1) where d = iter_ t i -{-# RULES -"TEXT take -> fused" [~1] forall n t. - take n t = unstream (S.take n (stream t)) -"TEXT take -> unfused" [1] forall n t. - unstream (S.take n (stream t)) = take n t - #-} - -- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after -- taking @n@ characters from the end of @t@. -- @@ -1186,7 +1119,7 @@ iterNEnd n t@(Text _arr _off len) = loop (len-1) n -- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the -- 'Text' after the first @n@ characters, or the empty 'Text' if @n@ --- is greater than the length of the 'Text'. Subject to fusion. +-- is greater than the length of the 'Text'. drop :: Int -> Text -> Text drop n t@(Text arr off len) | n <= 0 = t @@ -1195,13 +1128,6 @@ drop n t@(Text arr off len) where i = iterN n t {-# INLINE [1] drop #-} -{-# RULES -"TEXT drop -> fused" [~1] forall n t. - drop n t = unstream (S.drop n (stream t)) -"TEXT drop -> unfused" [1] forall n t. - unstream (S.drop n (stream t)) = drop n t - #-} - -- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after -- dropping @n@ characters from the end of @t@. -- @@ -1219,7 +1145,7 @@ dropEnd n t@(Text arr off len) -- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', -- returns the longest prefix (possibly empty) of elements that --- satisfy @p@. Subject to fusion. +-- satisfy @p@. takeWhile :: (Char -> Bool) -> Text -> Text takeWhile p t@(Text arr off len) = loop 0 where loop !i | i >= len = t @@ -1228,13 +1154,6 @@ takeWhile p t@(Text arr off len) = loop 0 where Iter c d = iter t i {-# INLINE [1] takeWhile #-} -{-# RULES -"TEXT takeWhile -> fused" [~1] forall p t. - takeWhile p t = unstream (S.takeWhile p (stream t)) -"TEXT takeWhile -> unfused" [1] forall p t. - unstream (S.takeWhile p (stream t)) = takeWhile p t - #-} - -- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text', -- returns the longest suffix (possibly empty) of elements that -- satisfy @p@. Subject to fusion. @@ -1260,7 +1179,7 @@ takeWhileEnd p t@(Text arr off len) = loop (len-1) len #-} -- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after --- 'takeWhile' @p@ @t@. Subject to fusion. +-- 'takeWhile' @p@ @t@. dropWhile :: (Char -> Bool) -> Text -> Text dropWhile p t@(Text arr off len) = loop 0 0 where loop !i !l | l >= len = empty @@ -1269,13 +1188,6 @@ dropWhile p t@(Text arr off len) = loop 0 0 where Iter c d = iter t i {-# INLINE [1] dropWhile #-} -{-# RULES -"TEXT dropWhile -> fused" [~1] forall p t. - dropWhile p t = unstream (S.dropWhile p (stream t)) -"TEXT dropWhile -> unfused" [1] forall p t. - unstream (S.dropWhile p (stream t)) = dropWhile p t - #-} - -- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after -- dropping characters that satisfy the predicate @p@ from the end of -- @t@. Subject to fusion. @@ -1301,7 +1213,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len -- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after -- dropping characters that satisfy the predicate @p@ from both the --- beginning and end of @t@. Subject to fusion. +-- beginning and end of @t@. dropAround :: (Char -> Bool) -> Text -> Text dropAround p = dropWhile p . dropWhileEnd p {-# INLINE [1] dropAround #-} @@ -1605,7 +1517,7 @@ index t n = S.index (stream t) n -- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text' -- and returns the index of the first element in the 'Text' satisfying --- the predicate. Subject to fusion. +-- the predicate. findIndex :: (Char -> Bool) -> Text -> Maybe Int findIndex p t = S.findIndex p (stream t) {-# INLINE findIndex #-} @@ -1629,7 +1541,7 @@ count pat src #-} -- | /O(n)/ The 'countChar' function returns the number of times the --- query element appears in the given 'Text'. Subject to fusion. +-- query element appears in the given 'Text'. countChar :: Char -> Text -> Int countChar c t = S.countChar c (stream t) {-# INLINE countChar #-} @@ -1714,17 +1626,12 @@ unwords = intercalate (singleton ' ') {-# INLINE unwords #-} -- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns --- 'True' iff the first is a prefix of the second. Subject to fusion. +-- 'True' iff the first is a prefix of the second. isPrefixOf :: Text -> Text -> Bool isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) = alen <= blen && S.isPrefixOf (stream a) (stream b) {-# INLINE [1] isPrefixOf #-} -{-# RULES -"TEXT isPrefixOf -> fused" [~1] forall s t. - isPrefixOf s t = S.isPrefixOf (stream s) (stream t) - #-} - -- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns -- 'True' iff the first is a suffix of the second. isSuffixOf :: Text -> Text -> Bool @@ -1748,11 +1655,6 @@ isInfixOf needle haystack | otherwise = not . L.null . indices needle $ haystack {-# INLINE [1] isInfixOf #-} -{-# RULES -"TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h. - isInfixOf (singleton n) h = S.elem n (S.stream h) - #-} - ------------------------------------------------------------------------------- -- * View patterns diff --git a/Data/Text/Encoding.hs b/Data/Text/Encoding.hs index fd0f1e42..e78e970a 100644 --- a/Data/Text/Encoding.hs +++ b/Data/Text/Encoding.hs @@ -348,8 +348,6 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0 decodeUtf8 :: ByteString -> Text decodeUtf8 = decodeUtf8With strictDecode {-# INLINE[0] decodeUtf8 #-} -{-# RULES "STREAM stream/decodeUtf8 fusion" [1] - forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-} -- | Decode a 'ByteString' containing UTF-8 encoded text. -- diff --git a/Data/Text/Internal/Fusion/Common.hs b/Data/Text/Internal/Fusion/Common.hs index 260dd3f4..98c99ad7 100644 --- a/Data/Text/Internal/Fusion/Common.hs +++ b/Data/Text/Internal/Fusion/Common.hs @@ -217,7 +217,6 @@ append (Stream next0 s01 len1) (Stream next1 s02 len2) = {-# INLINE [0] append #-} -- | /O(1)/ Returns the first character of a Text, which must be non-empty. --- Subject to array fusion. head :: Stream Char -> Char head (Stream next s0 _len) = loop_head s0 where @@ -232,7 +231,7 @@ head_empty = streamError "head" "Empty stream" {-# NOINLINE head_empty #-} -- | /O(1)/ Returns the first character and remainder of a 'Stream --- Char', or 'Nothing' if empty. Subject to array fusion. +-- Char', or 'Nothing' if empty. uncons :: Stream Char -> Maybe (Char, Stream Char) uncons (Stream next s0 len) = loop_uncons s0 where @@ -311,7 +310,6 @@ lengthI (Stream next s0 _len) = loop_length 0 s0 {-# INLINE[0] lengthI #-} -- | /O(n)/ Compares the count of characters in a string to a number. --- Subject to fusion. -- -- This function gives the same answer as comparing against the result -- of 'lengthI', but can short circuit if the count of characters is @@ -565,7 +563,6 @@ foldr f z (Stream next s0 _len) = loop_foldr s0 -- | foldr1 is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty streams. --- Subject to array fusion. foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char foldr1 f (Stream next s0 _len) = loop0_foldr1 s0 where @@ -587,7 +584,7 @@ intercalate s = concat . (L.intersperse s) -- ---------------------------------------------------------------------------- -- ** Special folds --- | /O(n)/ Concatenate a list of streams. Subject to array fusion. +-- | /O(n)/ Concatenate a list of streams. concat :: [Stream Char] -> Stream Char concat = L.foldr append empty {-# INLINE [0] concat #-} diff --git a/Data/Text/Lazy.hs b/Data/Text/Lazy.hs index 63840af0..4c08a47f 100644 --- a/Data/Text/Lazy.hs +++ b/Data/Text/Lazy.hs @@ -245,28 +245,11 @@ import Text.Printf (PrintfArg, formatArg, formatString) -- $fusion -- --- Most of the functions in this module are subject to /fusion/, --- meaning that a pipeline of such functions will usually allocate at --- most one 'Text' value. --- --- As an example, consider the following pipeline: --- --- > import Data.Text.Lazy as T --- > import Data.Text.Lazy.Encoding as E --- > import Data.ByteString.Lazy (ByteString) --- > --- > countChars :: ByteString -> Int --- > countChars = T.length . T.toUpper . E.decodeUtf8 --- --- From the type signatures involved, this looks like it should --- allocate one 'ByteString' value, and two 'Text' values. However, --- when a module is compiled with optimisation enabled under GHC, the --- two intermediate 'Text' values will be optimised away, and the --- function will be compiled down to a single loop over the source --- 'ByteString'. --- --- Functions that can be fused by the compiler are documented with the --- phrase \"Subject to fusion\". +-- Starting from @text-1.3@ fusion is no longer implicit, +-- and pipelines of transormations usually allocate intermediate 'Text' values. +-- Users, who observe significant changes to performances, +-- are encouraged to use fusion framework explicitly, employing +-- "Data.Text.Internal.Fusion" and "Data.Text.Internal.Fusion.Common". -- $replacement -- @@ -415,14 +398,21 @@ textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr] -- | /O(n)/ Convert a 'String' into a 'Text'. -- --- Subject to fusion. Performs replacement on invalid scalar values. -pack :: String -> Text +-- Performs replacement on invalid scalar values. +pack :: +#if defined(ASSERTS) + HasCallStack => +#endif + String -> Text pack = unstream . S.streamList . L.map safe {-# INLINE [1] pack #-} -- | /O(n)/ Convert a 'Text' into a 'String'. --- Subject to fusion. -unpack :: Text -> String +unpack :: +#if defined(ASSERTS) + HasCallStack => +#endif + Text -> String unpack t = S.unstreamList (stream t) {-# INLINE [1] unpack #-} @@ -447,19 +437,12 @@ unpackCString# addr# = unstream (S.streamCString# addr#) unstream (S.streamList (L.map safe [a])) = Chunk (T.singleton a) Empty #-} --- | /O(1)/ Convert a character into a Text. Subject to fusion. +-- | /O(1)/ Convert a character into a Text. -- Performs replacement on invalid scalar values. singleton :: Char -> Text singleton c = Chunk (T.singleton c) Empty {-# INLINE [1] singleton #-} -{-# RULES -"LAZY TEXT singleton -> fused" [~1] forall c. - singleton c = unstream (S.singleton c) -"LAZY TEXT singleton -> unfused" [1] forall c. - unstream (S.singleton c) = singleton c - #-} - -- | /O(c)/ Convert a list of strict 'T.Text's into a lazy 'Text'. fromChunks :: [T.Text] -> Text fromChunks cs = L.foldr chunk Empty cs @@ -481,47 +464,26 @@ fromStrict t = chunk t Empty -- ----------------------------------------------------------------------------- -- * Basic functions --- | /O(1)/ Adds a character to the front of a 'Text'. Subject to fusion. +-- | /O(1)/ Adds a character to the front of a 'Text'. cons :: Char -> Text -> Text cons c t = Chunk (T.singleton c) t {-# INLINE [1] cons #-} infixr 5 `cons` -{-# RULES -"LAZY TEXT cons -> fused" [~1] forall c t. - cons c t = unstream (S.cons c (stream t)) -"LAZY TEXT cons -> unfused" [1] forall c t. - unstream (S.cons c (stream t)) = cons c t - #-} - -- | /O(n)/ Adds a character to the end of a 'Text'. This copies the --- entire array in the process, unless fused. Subject to fusion. +-- entire array in the process. snoc :: Text -> Char -> Text snoc t c = foldrChunks Chunk (singleton c) t {-# INLINE [1] snoc #-} -{-# RULES -"LAZY TEXT snoc -> fused" [~1] forall t c. - snoc t c = unstream (S.snoc (stream t) c) -"LAZY TEXT snoc -> unfused" [1] forall t c. - unstream (S.snoc (stream t) c) = snoc t c - #-} - --- | /O(n\/c)/ Appends one 'Text' to another. Subject to fusion. +-- | /O(n\/c)/ Appends one 'Text' to another. append :: Text -> Text -> Text append xs ys = foldrChunks Chunk ys xs {-# INLINE [1] append #-} -{-# RULES -"LAZY TEXT append -> fused" [~1] forall t1 t2. - append t1 t2 = unstream (S.append (stream t1) (stream t2)) -"LAZY TEXT append -> unfused" [1] forall t1 t2. - unstream (S.append (stream t1) (stream t2)) = append t1 t2 - #-} - -- | /O(1)/ Returns the first character and rest of a 'Text', or --- 'Nothing' if empty. Subject to fusion. +-- 'Nothing' if empty. uncons :: Text -> Maybe (Char, Text) uncons Empty = Nothing uncons (Chunk t ts) = Just (T.unsafeHead t, ts') @@ -530,27 +492,20 @@ uncons (Chunk t ts) = Just (T.unsafeHead t, ts') {-# INLINE uncons #-} -- | /O(1)/ Returns the first character of a 'Text', which must be --- non-empty. Subject to fusion. +-- non-empty. head :: Text -> Char head t = S.head (stream t) {-# INLINE head #-} -- | /O(1)/ Returns all characters after the head of a 'Text', which --- must be non-empty. Subject to fusion. +-- must be non-empty. tail :: Text -> Text tail (Chunk t ts) = chunk (T.tail t) ts tail Empty = emptyError "tail" {-# INLINE [1] tail #-} -{-# RULES -"LAZY TEXT tail -> fused" [~1] forall t. - tail t = unstream (S.tail (stream t)) -"LAZY TEXT tail -> unfused" [1] forall t. - unstream (S.tail (stream t)) = tail t - #-} - -- | /O(n\/c)/ Returns all but the last character of a 'Text', which must --- be non-empty. Subject to fusion. +-- be non-empty. init :: Text -> Text init (Chunk t0 ts0) = go t0 ts0 where go t (Chunk t' ts) = Chunk t (go t' ts) @@ -558,13 +513,6 @@ init (Chunk t0 ts0) = go t0 ts0 init Empty = emptyError "init" {-# INLINE [1] init #-} -{-# RULES -"LAZY TEXT init -> fused" [~1] forall t. - init t = unstream (S.init (stream t)) -"LAZY TEXT init -> unfused" [1] forall t. - unstream (S.init (stream t)) = init t - #-} - -- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if -- empty. -- @@ -576,28 +524,19 @@ unsnoc Empty = Nothing unsnoc ts@(Chunk _ _) = Just (init ts, last ts) {-# INLINE unsnoc #-} --- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to --- fusion. +-- | /O(1)/ Tests whether a 'Text' is empty or not. null :: Text -> Bool null Empty = True null _ = False {-# INLINE [1] null #-} -{-# RULES -"LAZY TEXT null -> fused" [~1] forall t. - null t = S.null (stream t) -"LAZY TEXT null -> unfused" [1] forall t. - S.null (stream t) = null t - #-} - -- | /O(1)/ Tests whether a 'Text' contains exactly one character. --- Subject to fusion. isSingleton :: Text -> Bool isSingleton = S.isSingleton . stream {-# INLINE isSingleton #-} -- | /O(n\/c)/ Returns the last character of a 'Text', which must be --- non-empty. Subject to fusion. +-- non-empty. last :: Text -> Char last Empty = emptyError "last" last (Chunk t ts) = go t ts @@ -605,29 +544,13 @@ last (Chunk t ts) = go t ts go t' Empty = T.last t' {-# INLINE [1] last #-} -{-# RULES -"LAZY TEXT last -> fused" [~1] forall t. - last t = S.last (stream t) -"LAZY TEXT last -> unfused" [1] forall t. - S.last (stream t) = last t - #-} - -- | /O(n)/ Returns the number of characters in a 'Text'. --- Subject to fusion. length :: Text -> Int64 length = foldlChunks go 0 where go l t = l + fromIntegral (T.length t) {-# INLINE [1] length #-} -{-# RULES -"LAZY TEXT length -> fused" [~1] forall t. - length t = S.length (stream t) -"LAZY TEXT length -> unfused" [1] forall t. - S.length (stream t) = length t - #-} - -- | /O(n)/ Compare the count of characters in a 'Text' to a number. --- Subject to fusion. -- -- This function gives the same answer as comparing against the result -- of 'length', but can short circuit if the count of characters is @@ -641,7 +564,7 @@ compareLength t n = S.compareLengthI (stream t) n -- properties of code. -- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to --- each element of @t@. Subject to fusion. Performs replacement on +-- each element of @t@. Performs replacement on -- invalid scalar values. map :: (Char -> Char) -> Text -> Text map f t = unstream (S.map (safe . f) (stream t)) @@ -655,14 +578,14 @@ intercalate t = concat . (F.intersperse t) {-# INLINE intercalate #-} -- | /O(n)/ The 'intersperse' function takes a character and places it --- between the characters of a 'Text'. Subject to fusion. Performs +-- between the characters of a 'Text'. Performs -- replacement on invalid scalar values. intersperse :: Char -> Text -> Text intersperse c t = unstream (S.intersperse (safe c) (stream t)) {-# INLINE intersperse #-} -- | /O(n)/ Left-justify a string to the given length, using the --- specified fill character on the right. Subject to fusion. Performs +-- specified fill character on the right. Performs -- replacement on invalid scalar values. -- -- Examples: @@ -676,13 +599,6 @@ justifyLeft k c t where len = length t {-# INLINE [1] justifyLeft #-} -{-# RULES -"LAZY TEXT justifyLeft -> fused" [~1] forall k c t. - justifyLeft k c t = unstream (S.justifyLeftI k c (stream t)) -"LAZY TEXT justifyLeft -> unfused" [1] forall k c t. - unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t - #-} - -- | /O(n)/ Right-justify a string to the given length, using the -- specified fill character on the left. Performs replacement on -- invalid scalar values. @@ -776,7 +692,7 @@ replace s d = intercalate d . splitOn s -- functions may map one input character to two or three output -- characters. --- | /O(n)/ Convert a string to folded case. Subject to fusion. +-- | /O(n)/ Convert a string to folded case. -- -- This function is mainly useful for performing caseless (or case -- insensitive) string comparisons. @@ -796,7 +712,7 @@ toCaseFold t = unstream (S.toCaseFold (stream t)) {-# INLINE [0] toCaseFold #-} -- | /O(n)/ Convert a string to lower case, using simple case --- conversion. Subject to fusion. +-- conversion. -- -- The result string may be longer than the input string. For -- instance, the Latin capital letter I with dot above (U+0130) maps @@ -807,7 +723,7 @@ toLower t = unstream (S.toLower (stream t)) {-# INLINE toLower #-} -- | /O(n)/ Convert a string to upper case, using simple case --- conversion. Subject to fusion. +-- conversion. -- -- The result string may be longer than the input string. For -- instance, the German eszett (U+00DF) maps to the two-letter @@ -818,7 +734,7 @@ toUpper t = unstream (S.toUpper (stream t)) -- | /O(n)/ Convert a string to title case, using simple case --- conversion. Subject to fusion. +-- conversion. -- -- The first letter of the input is converted to title case, as is -- every subsequent letter that immediately follows a non-letter. @@ -844,24 +760,23 @@ toTitle t = unstream (S.toTitle (stream t)) -- | /O(n)/ 'foldl', applied to a binary operator, a starting value -- (typically the left-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from left to right. --- Subject to fusion. foldl :: (a -> Char -> a) -> a -> Text -> a foldl f z t = S.foldl f z (stream t) {-# INLINE foldl #-} -- | /O(n)/ A strict version of 'foldl'. --- Subject to fusion. +-- foldl' :: (a -> Char -> a) -> a -> Text -> a foldl' f z t = S.foldl' f z (stream t) {-# INLINE foldl' #-} -- | /O(n)/ A variant of 'foldl' that has no starting value argument, --- and thus must be applied to a non-empty 'Text'. Subject to fusion. +-- and thus must be applied to a non-empty 'Text'. foldl1 :: (Char -> Char -> Char) -> Text -> Char foldl1 f t = S.foldl1 f (stream t) {-# INLINE foldl1 #-} --- | /O(n)/ A strict version of 'foldl1'. Subject to fusion. +-- | /O(n)/ A strict version of 'foldl1'. foldl1' :: (Char -> Char -> Char) -> Text -> Char foldl1' f t = S.foldl1' f (stream t) {-# INLINE foldl1' #-} @@ -869,14 +784,12 @@ foldl1' f t = S.foldl1' f (stream t) -- | /O(n)/ 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a 'Text', -- reduces the 'Text' using the binary operator, from right to left. --- Subject to fusion. foldr :: (Char -> a -> a) -> a -> Text -> a foldr f z t = S.foldr f z (stream t) {-# INLINE foldr #-} -- | /O(n)/ A variant of 'foldr' that has no starting value argument, --- and thus must be applied to a non-empty 'Text'. Subject to --- fusion. +-- and thus must be applied to a non-empty 'Text'. foldr1 :: (Char -> Char -> Char) -> Text -> Char foldr1 f t = S.foldr1 f (stream t) {-# INLINE foldr1 #-} @@ -898,31 +811,31 @@ concatMap f = concat . foldr ((:) . f) [] {-# INLINE concatMap #-} -- | /O(n)/ 'any' @p@ @t@ determines whether any character in the --- 'Text' @t@ satisfies the predicate @p@. Subject to fusion. +-- 'Text' @t@ satisfies the predicate @p@. any :: (Char -> Bool) -> Text -> Bool any p t = S.any p (stream t) {-# INLINE any #-} -- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the --- 'Text' @t@ satisfy the predicate @p@. Subject to fusion. +-- 'Text' @t@ satisfy the predicate @p@. all :: (Char -> Bool) -> Text -> Bool all p t = S.all p (stream t) {-# INLINE all #-} -- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which --- must be non-empty. Subject to fusion. +-- must be non-empty. maximum :: Text -> Char maximum t = S.maximum (stream t) {-# INLINE maximum #-} -- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which --- must be non-empty. Subject to fusion. +-- must be non-empty. minimum :: Text -> Char minimum t = S.minimum (stream t) {-# INLINE minimum #-} -- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of --- successive reduced values from the left. Subject to fusion. +-- successive reduced values from the left. -- Performs replacement on invalid scalar values. -- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] @@ -1026,7 +939,7 @@ iterate f c = let t c' = Chunk (T.singleton c') (t (f c')) in t c -- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the --- value of every element. Subject to fusion. +-- value of every element. replicateChar :: Int64 -> Char -> Text replicateChar n c = unstream (S.replicateCharI n (safe c)) {-# INLINE replicateChar #-} @@ -1041,8 +954,6 @@ replicateChar n c = unstream (S.replicateCharI n (safe c)) -- 'Text' from a seed value. The function takes the element and -- returns 'Nothing' if it is done producing the 'Text', otherwise -- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the --- string, and @b@ is the seed value for further production. Performs --- replacement on invalid scalar values. unfoldr :: (a -> Maybe (Char,a)) -> a -> Text unfoldr f s = unstream (S.unfoldr (firstf safe . f) s) {-# INLINE unfoldr #-} @@ -1059,7 +970,7 @@ unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s) -- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the -- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than --- the length of the Text. Subject to fusion. +-- the length of the Text. take :: Int64 -> Text -> Text take i _ | i <= 0 = Empty take i t0 = take' i t0 @@ -1071,13 +982,6 @@ take i t0 = take' i t0 where len = fromIntegral (T.length t) {-# INLINE [1] take #-} -{-# RULES -"LAZY TEXT take -> fused" [~1] forall n t. - take n t = unstream (S.take n (stream t)) -"LAZY TEXT take -> unfused" [1] forall n t. - unstream (S.take n (stream t)) = take n t - #-} - -- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after -- taking @n@ characters from the end of @t@. -- @@ -1098,7 +1002,7 @@ takeEnd n t0 -- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the -- 'Text' after the first @n@ characters, or the empty 'Text' if @n@ --- is greater than the length of the 'Text'. Subject to fusion. +-- is greater than the length of the 'Text'. drop :: Int64 -> Text -> Text drop i t0 | i <= 0 = t0 @@ -1111,13 +1015,6 @@ drop i t0 where len = fromIntegral (T.length t) {-# INLINE [1] drop #-} -{-# RULES -"LAZY TEXT drop -> fused" [~1] forall n t. - drop n t = unstream (S.drop n (stream t)) -"LAZY TEXT drop -> unfused" [1] forall n t. - unstream (S.drop n (stream t)) = drop n t - #-} - -- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after -- dropping @n@ characters from the end of @t@. -- @@ -1154,7 +1051,7 @@ dropWords i t0 -- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', -- returns the longest prefix (possibly empty) of elements that --- satisfy @p@. Subject to fusion. +-- satisfy @p@. takeWhile :: (Char -> Bool) -> Text -> Text takeWhile p t0 = takeWhile' t0 where takeWhile' Empty = Empty @@ -1165,12 +1062,6 @@ takeWhile p t0 = takeWhile' t0 Nothing -> Chunk t (takeWhile' ts) {-# INLINE [1] takeWhile #-} -{-# RULES -"LAZY TEXT takeWhile -> fused" [~1] forall p t. - takeWhile p t = unstream (S.takeWhile p (stream t)) -"LAZY TEXT takeWhile -> unfused" [1] forall p t. - unstream (S.takeWhile p (stream t)) = takeWhile p t - #-} -- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text', -- returns the longest suffix (possibly empty) of elements that -- satisfy @p@. @@ -1190,7 +1081,7 @@ takeWhileEnd p = takeChunk empty . L.reverse . toChunks {-# INLINE takeWhileEnd #-} -- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after --- 'takeWhile' @p@ @t@. Subject to fusion. +-- 'takeWhile' @p@ @t@. dropWhile :: (Char -> Bool) -> Text -> Text dropWhile p t0 = dropWhile' t0 where dropWhile' Empty = Empty @@ -1200,13 +1091,6 @@ dropWhile p t0 = dropWhile' t0 Nothing -> dropWhile' ts {-# INLINE [1] dropWhile #-} -{-# RULES -"LAZY TEXT dropWhile -> fused" [~1] forall p t. - dropWhile p t = unstream (S.dropWhile p (stream t)) -"LAZY TEXT dropWhile -> unfused" [1] forall p t. - unstream (S.dropWhile p (stream t)) = dropWhile p t - #-} - -- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after -- dropping characters that satisfy the predicate @p@ from the end of -- @t@. @@ -1523,7 +1407,7 @@ unwords = intercalate (singleton ' ') {-# INLINE unwords #-} -- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns --- 'True' iff the first is a prefix of the second. Subject to fusion. +-- 'True' iff the first is a prefix of the second. isPrefixOf :: Text -> Text -> Bool isPrefixOf Empty _ = True isPrefixOf _ Empty = False @@ -1537,13 +1421,6 @@ isPrefixOf (Chunk x xs) (Chunk y ys) ly = T.length y {-# INLINE [1] isPrefixOf #-} -{-# RULES -"LAZY TEXT isPrefixOf -> fused" [~1] forall s t. - isPrefixOf s t = S.isPrefixOf (stream s) (stream t) -"LAZY TEXT isPrefixOf -> unfused" [1] forall s t. - S.isPrefixOf (stream s) (stream t) = isPrefixOf s t - #-} - -- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns -- 'True' iff the first is a suffix of the second. isSuffixOf :: Text -> Text -> Bool @@ -1567,11 +1444,6 @@ isInfixOf needle haystack | otherwise = not . L.null . indices needle $ haystack {-# INLINE [1] isInfixOf #-} -{-# RULES -"LAZY TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h. - isInfixOf (singleton n) h = S.elem n (S.stream h) - #-} - ------------------------------------------------------------------------------- -- * View patterns @@ -1695,7 +1567,7 @@ count pat src #-} -- | /O(n)/ The 'countChar' function returns the number of times the --- query element appears in the given 'Text'. Subject to fusion. +-- query element appears in the given 'Text'. countChar :: Char -> Text -> Int64 countChar c t = S.countChar c (stream t) diff --git a/Data/Text/Lazy/Encoding.hs b/Data/Text/Lazy/Encoding.hs index ac1464de..9a200d0c 100644 --- a/Data/Text/Lazy/Encoding.hs +++ b/Data/Text/Lazy/Encoding.hs @@ -119,10 +119,6 @@ decodeUtf8 :: B.ByteString -> Text decodeUtf8 = decodeUtf8With strictDecode {-# INLINE[0] decodeUtf8 #-} --- This rule seems to cause performance loss. -{- RULES "LAZY STREAM stream/decodeUtf8' fusion" [1] - forall bs. F.stream (decodeUtf8' bs) = E.streamUtf8 strictDecode bs #-} - -- | Decode a 'ByteString' containing UTF-8 encoded text.. -- -- If the input contains any invalid UTF-8 data, the relevant diff --git a/Data/Text/Show.hs b/Data/Text/Show.hs index 04d2a28b..10aff295 100644 --- a/Data/Text/Show.hs +++ b/Data/Text/Show.hs @@ -37,8 +37,12 @@ import qualified GHC.Base as GHC instance Show Text where showsPrec p ps r = showsPrec p (unpack ps) r --- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion. -unpack :: Text -> String +-- | /O(n)/ Convert a 'Text' into a 'String'. +unpack :: +#if defined(ASSERTS) + HasCallStack => +#endif + Text -> String unpack = S.unstreamList . stream {-# INLINE [1] unpack #-} @@ -68,7 +72,7 @@ unpackCString# addr# = unstream (S.streamCString# addr#) unstream (S.map safe (S.streamList [a])) = singleton_ a #-} --- | /O(1)/ Convert a character into a Text. Subject to fusion. +-- | /O(1)/ Convert a character into a Text. -- Performs replacement on invalid scalar values. singleton :: Char -> Text singleton = unstream . S.singleton . safe diff --git a/changelog.md b/changelog.md index 04e8eb90..d4591c89 100644 --- a/changelog.md +++ b/changelog.md @@ -1,4 +1,7 @@ #### 1.2.3.2 +* Disable implicit fusion rules + +### 1.2.4.2 * Special release supporting GHC 8.10.1 / `base-4.14.0.0` only diff --git a/tests/Tests.hs b/tests/Tests.hs index fb97ff4a..8bb99f68 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -10,4 +10,8 @@ import qualified Tests.Properties as Properties import qualified Tests.Regressions as Regressions main :: IO () -main = defaultMain [Properties.tests, Regressions.tests] +main = defaultMain $ testGroup "All" + [ Lift.tests + , Properties.tests + , Regressions.tests + ] diff --git a/text.cabal b/text.cabal index b549e5a5..292f50a0 100644 --- a/text.cabal +++ b/text.cabal @@ -175,107 +175,6 @@ library UnboxedTuples UnliftedFFITypes -test-suite tests - type: exitcode-stdio-1.0 - c-sources: cbits/cbits.c - include-dirs: include - - ghc-options: - -Wall -threaded -rtsopts - - cpp-options: - -DASSERTS -DTEST_SUITE - - -- modules specific to test-suite - hs-source-dirs: tests - main-is: Tests.hs - other-modules: - Tests.Properties - Tests.Properties.Mul - Tests.QuickCheckUtils - Tests.Regressions - Tests.SlowFunctions - Tests.Utils - - -- Same as in `library` stanza; this is needed by cabal for accurate - -- file-monitoring as well as to avoid `-Wmissing-home-modules` - -- warnings We can't use an inter-package library dependency because - -- of different `ghc-options`/`cpp-options` (as a side-benefitt, - -- this enables per-component build parallelism in `cabal - -- new-build`!); We could, however, use cabal-version:2.2's `common` - -- blocks at some point in the future to reduce the duplication. - hs-source-dirs: . - other-modules: - Data.Text - Data.Text.Array - Data.Text.Encoding - Data.Text.Encoding.Error - Data.Text.Foreign - Data.Text.IO - Data.Text.Internal - Data.Text.Internal.Builder - Data.Text.Internal.Builder.Functions - Data.Text.Internal.Builder.Int.Digits - Data.Text.Internal.Builder.RealFloat.Functions - Data.Text.Internal.Encoding.Fusion - Data.Text.Internal.Encoding.Fusion.Common - Data.Text.Internal.Encoding.Utf16 - Data.Text.Internal.Encoding.Utf32 - Data.Text.Internal.Encoding.Utf8 - Data.Text.Internal.Functions - Data.Text.Internal.Fusion - Data.Text.Internal.Fusion.CaseMapping - Data.Text.Internal.Fusion.Common - Data.Text.Internal.Fusion.Size - Data.Text.Internal.Fusion.Types - Data.Text.Internal.IO - Data.Text.Internal.Lazy - Data.Text.Internal.Lazy.Encoding.Fusion - Data.Text.Internal.Lazy.Fusion - Data.Text.Internal.Lazy.Search - Data.Text.Internal.Private - Data.Text.Internal.Read - Data.Text.Internal.Search - Data.Text.Internal.Unsafe - Data.Text.Internal.Unsafe.Char - Data.Text.Internal.Unsafe.Shift - Data.Text.Lazy - Data.Text.Lazy.Builder - Data.Text.Lazy.Builder.Int - Data.Text.Lazy.Builder.RealFloat - Data.Text.Lazy.Encoding - Data.Text.Lazy.IO - Data.Text.Lazy.Internal - Data.Text.Lazy.Read - Data.Text.Read - Data.Text.Unsafe - Data.Text.Show - - build-depends: - HUnit >= 1.2, - QuickCheck >= 2.7 && < 2.11, - array, - base, - binary, - deepseq, - directory, - ghc-prim, - quickcheck-unicode >= 1.0.1.0, - random, - test-framework >= 0.4, - test-framework-hunit >= 0.2, - test-framework-quickcheck2 >= 0.2, - bytestring >= 0.10.4 - - if flag(integer-simple) - cpp-options: -DINTEGER_SIMPLE - build-depends: integer-simple >= 0.1 && < 0.5 - else - cpp-options: -DINTEGER_GMP - build-depends: integer-gmp >= 0.2 - - default-language: Haskell2010 - default-extensions: NondecreasingIndentation source-repository head type: git