Optimise the Typeable instance for type app a bit, and add a perf test
authorSimon Marlow <marlowsd@gmail.com>
Tue, 17 Jun 2014 10:47:40 +0000 (11:47 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 17 Jun 2014 10:47:40 +0000 (11:47 +0100)
Test Plan: validate

Reviewers: simonpj, austin

Subscribers: simonmar, relrod

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

libraries/base/Data/Typeable/Internal.hs
testsuite/tests/perf/should_run/T9203.hs [new file with mode: 0644]
testsuite/tests/perf/should_run/T9203.stdout [new file with mode: 0644]
testsuite/tests/perf/should_run/all.T

index 5b1cde4..a09d4ad 100644 (file)
@@ -1,4 +1,5 @@
 {-# LANGUAGE Unsafe             #-}
+{-# LANGUAGE BangPatterns #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -263,9 +264,19 @@ type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a
 
 -- | Kind-polymorphic Typeable instance for type application
 instance (Typeable s, Typeable a) => Typeable (s a) where
-  typeRep# = \_ -> rep
-    where rep = typeRep# (proxy# :: Proxy# s)
-                   `mkAppTy` typeRep# (proxy# :: Proxy# a)
+  typeRep# = \_ -> rep                  -- Note [Memoising typeOf]
+    where !ty1 = typeRep# (proxy# :: Proxy# s)
+          !ty2 = typeRep# (proxy# :: Proxy# a)
+          !rep = ty1 `mkAppTy` ty2
+
+{- Note [Memoising typeOf]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+See #3245, #9203
+
+IMPORTANT: we don't want to recalculate the TypeRep once per call with
+the proxy argument.  This is what went wrong in #3245 and #9203. So we
+help GHC by manually keeping the 'rep' *outside* the lambda.
+-}
 
 ----------------- Showing TypeReps --------------------
 
diff --git a/testsuite/tests/perf/should_run/T9203.hs b/testsuite/tests/perf/should_run/T9203.hs
new file mode 100644 (file)
index 0000000..500fd8c
--- /dev/null
@@ -0,0 +1,9 @@
+module Main where
+
+import Data.Typeable
+
+f :: Typeable a => Int -> a -> TypeRep
+f 0 a = typeOf a
+f n a = f (n-1) [a]
+
+main = print (f 50000 () == f 50001 ())
diff --git a/testsuite/tests/perf/should_run/T9203.stdout b/testsuite/tests/perf/should_run/T9203.stdout
new file mode 100644 (file)
index 0000000..bc59c12
--- /dev/null
@@ -0,0 +1 @@
+False
index 8030251..94fd2a3 100644 (file)
@@ -366,3 +366,11 @@ test('InlineCloneArrayAlloc',
       only_ways(['normal'])],
      compile_and_run,
      ['-O2'])
+
+test('T9203',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(32), 50000000, 5)
+                      , (wordsize(64), 95747304, 5) ]),
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])