diff --git a/Data/Text.hs b/Data/Text.hs index df032059..dad9bdae 100644 --- a/Data/Text.hs +++ b/Data/Text.hs @@ -167,6 +167,7 @@ module Data.Text , isPrefixOf , isSuffixOf , isInfixOf + , transformEq -- ** View patterns , stripPrefix @@ -1753,6 +1754,15 @@ isInfixOf needle haystack isInfixOf (singleton n) h = S.elem n (S.stream h) #-} +-- | The 'transformEq' function takes a `Text -> Text` function +-- and two 'Text's if the 'Text's are equal after transformation. This +-- function relies on fusion to avoid materialising the transformed 'Text' +transformEq :: (Text -> Text) -> Text -> Text -> Bool +transformEq f x y + | length x == length y = S.stream (f x) == S.stream (f y) + | otherwise = False +{-# INLINE [1] transformEq #-} + ------------------------------------------------------------------------------- -- * View patterns diff --git a/benchmarks/haskell/Benchmarks.hs b/benchmarks/haskell/Benchmarks.hs index fdecba79..04387c08 100644 --- a/benchmarks/haskell/Benchmarks.hs +++ b/benchmarks/haskell/Benchmarks.hs @@ -14,6 +14,7 @@ import qualified Benchmarks.Concat as Concat import qualified Benchmarks.DecodeUtf8 as DecodeUtf8 import qualified Benchmarks.EncodeUtf8 as EncodeUtf8 import qualified Benchmarks.Equality as Equality +import qualified Benchmarks.TransformEq as TransformEq import qualified Benchmarks.FileRead as FileRead import qualified Benchmarks.FoldLines as FoldLines import qualified Benchmarks.Mul as Mul @@ -63,6 +64,7 @@ benchmarks = do , Search.benchmark (tf "russian.txt") "принимая" , Stream.benchmark (tf "russian.txt") , WordFrequencies.benchmark (tf "russian.txt") + , TransformEq.benchmark ] -- Program-like benchmarks diff --git a/benchmarks/haskell/Benchmarks/TransformEq.hs b/benchmarks/haskell/Benchmarks/TransformEq.hs new file mode 100644 index 00000000..0063a306 --- /dev/null +++ b/benchmarks/haskell/Benchmarks/TransformEq.hs @@ -0,0 +1,30 @@ +-- | Compare a string after a transformation +-- +-- Tested in this benchmark: +-- +-- * Comparison of transformed strings via transformEq +-- +module Benchmarks.TransformEq + ( benchmark + ) where + +import Criterion (Benchmark, bgroup, bench, whnf) +import Data.Function (on) +import Data.Text (transformEq, toCaseFold, pack) + +benchmark :: IO Benchmark +benchmark = do + let + equiv = (pack "Fooooooo", pack "fOOOOOOO") + notEq = (pack "fooooooo", pack "barrrrrr") + lengthNotEq = (pack "foo", pack "foooooooo") + eq = uncurry ((==) `on` toCaseFold) + transEq = uncurry $ transformEq toCaseFold + return $ bgroup "transformEq" + [ bench "Text ==: Eq" $ whnf eq equiv + , bench "Text transformEq: Eq" $ whnf transEq equiv + , bench "Text ==: Not Eq" $ whnf eq notEq + , bench "Text transformEq: Not Eq" $ whnf transEq notEq + , bench "Text ==: Not Length" $ whnf eq lengthNotEq + , bench "Text transformEq: Not Length" $ whnf transEq lengthNotEq + ] diff --git a/benchmarks/text-benchmarks.cabal b/benchmarks/text-benchmarks.cabal index 073dfeee..1c9490a2 100644 --- a/benchmarks/text-benchmarks.cabal +++ b/benchmarks/text-benchmarks.cabal @@ -76,6 +76,7 @@ executable text-benchmarks Benchmarks.Replace Benchmarks.Search Benchmarks.Stream + Benchmarks.TransformEq Benchmarks.WordFrequencies -- Source code for IUT (implementation under test)