Add a perf test for deriving null

Deriving null even helps for a simple list-like type,
presumably because we don't perform the static argument
transformation. Adding this test before the null deriving
patch should give a proper baseline.

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3408

3 files changed, 32 insertions, 0 deletions

diff --git a/testsuite/tests/perf/should_run/DeriveNull.hs b/testsuite/tests/perf/should_run/DeriveNull.hs
new file mode 100644
index 0000000000..cb95b278ce
--- /dev/null
+++ b/testsuite/tests/perf/should_run/DeriveNull.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE DeriveFoldable #-}
+
+module Main where
+import Data.Semigroup
+
+-- Just a list without any special fusion rules.
+data List a = Nil | Cons a (List a) deriving Foldable
+
+instance Semigroup (List a) where
+  Nil <> ys = ys
+  Cons x xs <> ys = Cons x (xs <> ys)
+
+replicateList :: Int -> a -> List a
+replicateList 0 x = Nil
+replicateList n x = Cons x (replicateList (n - 1) x)
+
+newtype ListList a = ListList (List (List a)) deriving Foldable
+
+long :: Int -> Bool
+long n = null $ ListList $ replicateList n Nil <> Cons (Cons () Nil) Nil
+
+main :: IO ()
+main = print $ long (10^(6 :: Int))
diff --git a/testsuite/tests/perf/should_run/DeriveNull.stdout b/testsuite/tests/perf/should_run/DeriveNull.stdout
new file mode 100644
index 0000000000..bc59c12aa1
--- /dev/null
+++ b/testsuite/tests/perf/should_run/DeriveNull.stdout
@@ -0,0 +1 @@
+False
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index f0a8becd58..a70cf3892a 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -526,3 +526,11 @@ test('T13218',
      only_ways(['normal'])],
     compile_and_run,
     ['-O'])
+
+test('DeriveNull',
+    [stats_num_field('bytes allocated',
+                    [ (wordsize(64), 152083704, 5) ]),
+                    # 2017-04-02     152083704 w/o derived null
+     only_ways(['normal'])],
+    compile_and_run,
+    ['-O'])