Skip to content

Instantly share code, notes, and snippets.

@andrewthad
Created September 11, 2016 14:57
Show Gist options
  • Save andrewthad/c74dac703139248a49a23bfd681914b0 to your computer and use it in GitHub Desktop.
Save andrewthad/c74dac703139248a49a23bfd681914b0 to your computer and use it in GitHub Desktop.
{-# OPTIONS -O2 -Wall #-}
module Main (main) where
import Criterion.Main
import Data.Text (Text)
import qualified Data.Text as Text
-- This benchmark demonstrates the non-linear performance of
-- appending text. The behavior I would expect would be that
-- stream fusion would cause appending twenty characters to
-- take four times as long as appending five characters. However,
-- this is not the case.
main :: IO ()
main = defaultMain
[ bgroup "Text Append Fusion"
[ bench "Five Chars" $ whnf fiveChars 'x'
, bench "Ten Chars" $ whnf tenChars 'x'
, bench "Ten Chars (left-associated append)" $ whnf tenCharsAssociateLeft 'x'
, bench "Twenty Chars" $ whnf twentyChars 'x'
, bench "Twenty Chars (left-associated append)" $ whnf twentyCharsAssociateLeft 'x'
]
]
fiveChars :: Char -> Text
fiveChars =
mappend (Text.singleton 'a')
. mappend (Text.singleton 'b')
. mappend (Text.singleton 'c')
. mappend (Text.singleton 'd')
. Text.singleton
tenChars :: Char -> Text
tenChars =
mappend (Text.singleton 'a')
. mappend (Text.singleton 'b')
. mappend (Text.singleton 'c')
. mappend (Text.singleton 'd')
. mappend (Text.singleton 'e')
. mappend (Text.singleton 'f')
. mappend (Text.singleton 'g')
. mappend (Text.singleton 'h')
. mappend (Text.singleton 'i')
. Text.singleton
tenCharsAssociateLeft :: Char -> Text
tenCharsAssociateLeft a = (Text.singleton 'a')
`mappend` (Text.singleton 'b')
`mappend` (Text.singleton 'c')
`mappend` (Text.singleton 'd')
`mappend` (Text.singleton 'e')
`mappend` (Text.singleton 'f')
`mappend` (Text.singleton 'g')
`mappend` (Text.singleton 'h')
`mappend` (Text.singleton 'i')
`mappend` (Text.singleton a)
twentyChars :: Char -> Text
twentyChars =
mappend (Text.singleton 'a')
. mappend (Text.singleton 'b')
. mappend (Text.singleton 'c')
. mappend (Text.singleton 'd')
. mappend (Text.singleton 'e')
. mappend (Text.singleton 'f')
. mappend (Text.singleton 'g')
. mappend (Text.singleton 'h')
. mappend (Text.singleton 'i')
. mappend (Text.singleton 'j')
. mappend (Text.singleton 'k')
. mappend (Text.singleton 'l')
. mappend (Text.singleton 'm')
. mappend (Text.singleton 'n')
. mappend (Text.singleton 'o')
. mappend (Text.singleton 'p')
. mappend (Text.singleton 'q')
. mappend (Text.singleton 'r')
. mappend (Text.singleton 's')
. Text.singleton
twentyCharsAssociateLeft :: Char -> Text
twentyCharsAssociateLeft a = (Text.singleton 'a')
`mappend` (Text.singleton 'b')
`mappend` (Text.singleton 'c')
`mappend` (Text.singleton 'd')
`mappend` (Text.singleton 'e')
`mappend` (Text.singleton 'f')
`mappend` (Text.singleton 'g')
`mappend` (Text.singleton 'h')
`mappend` (Text.singleton 'i')
`mappend` (Text.singleton 'b')
`mappend` (Text.singleton 'c')
`mappend` (Text.singleton 'd')
`mappend` (Text.singleton 'e')
`mappend` (Text.singleton 'f')
`mappend` (Text.singleton 'g')
`mappend` (Text.singleton 'h')
`mappend` (Text.singleton 'i')
`mappend` (Text.singleton 'h')
`mappend` (Text.singleton 'i')
`mappend` (Text.singleton a)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment