Use top-level instances to solve superclasses where possible

This patch introduces a new flag `-fsolve-constant-dicts` which makes the
constraint solver solve super class constraints with available dictionaries if
possible. The flag is enabled by `-O1`.

The motivation of this patch is that the compiler can produce more efficient
code if the constraint solver used top-level instance declarations to solve
constraints that are currently solved givens and their superclasses. In
particular, as it currently stands, the compiler imposes a performance penalty
on the common use-case where superclasses are bundled together for user
convenience. The performance penalty applies to constraint synonyms as
well. This example illustrates the issue:

```
{-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, FlexibleContexts #-}
module B where

class M a b where m :: a -> b

type C a b = (Num a, M a b)

f :: C Int b => b -> Int -> Int
f _ x = x + 1
```

Output without the patch, notice that we get the instance for `Num Int` by
using the class selector `p1`.

```
f :: forall b_arz. C Int b_arz => b_arz -> Int -> Int
f =
  \ (@ b_a1EB) ($d(%,%)_a1EC :: C Int b_a1EB) _ (eta1_B1 :: Int) ->
    + @ Int
      (GHC.Classes.$p1(%,%) @ (Num Int) @ (M Int b_a1EB) $d(%,%)_a1EC)
      eta1_B1
      B.f1
```

Output with the patch, nicely optimised code!

```
f :: forall b. C Int b => b -> Int -> Int
f =
  \ (@ b) _ _ (x_azg :: Int) ->
    case x_azg of { GHC.Types.I# x1_a1DP ->
    GHC.Types.I# (GHC.Prim.+# x1_a1DP 1#)
    }
```

Reviewers: simonpj, bgamari, austin

Reviewed By: simonpj

Subscribers: mpickering, rwbarton, thomie

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

GHC Trac Issues: #12791, #5835

5 files changed, 52 insertions, 4 deletions

diff --git a/testsuite/tests/perf/should_run/T12791.hs b/testsuite/tests/perf/should_run/T12791.hs
new file mode 100644
index 0000000000..94ebee77ba
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T12791.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
+module Main ( main ) where
+
+class Foldable f => C f a where
+  m :: f a -> a
+
+instance C [] Int where
+  m = foldr (+) 0
+
+{-# NOINLINE go #-}
+go :: C [] b => b -> Int -> Int
+go _ i = foldr (+) 0 [1..i]
+
+main :: IO ()
+main = print $ go (0 :: Int) 20000
diff --git a/testsuite/tests/perf/should_run/T12791.stdout b/testsuite/tests/perf/should_run/T12791.stdout
new file mode 100644
index 0000000000..86d7234cf8
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T12791.stdout
@@ -0,0 +1 @@
+200010000
diff --git a/testsuite/tests/perf/should_run/T5835.hs b/testsuite/tests/perf/should_run/T5835.hs
new file mode 100644
index 0000000000..25787cb137
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T5835.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE GADTs #-}
+module Main where
+
+data T t a where
+  T :: (Foldable t, Eq a) => t a -> T t a
+
+{-# NOINLINE go #-}
+go :: T [] a -> Int -> Int
+go (T _) i = foldr (+) 0 [1..i]
+
+main = print (go (T [1::Int]) 20000)
diff --git a/testsuite/tests/perf/should_run/T5835.stdout b/testsuite/tests/perf/should_run/T5835.stdout
new file mode 100644
index 0000000000..86d7234cf8
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T5835.stdout
@@ -0,0 +1 @@
+200010000
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index be262ba1a9..382c317a9b 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -1,3 +1,23 @@
+# T12791 and T5835 test that GHC uses top-level instances in places where using
+# a locally given solution would produce worse code.
+# See Note [Solving from instances when interacting Dicts]
+
+test('T5835',
+     [stats_num_field('max_bytes_used',
+           [(wordsize(64), 44312, 10)]),
+       only_ways(['normal'])
+       ],
+     compile_and_run,
+     ['-O'])
+
+test('T12791',
+     [stats_num_field('max_bytes_used',
+           [(wordsize(64), 44312, 10)]),
+       only_ways(['normal'])
+       ],
+     compile_and_run,
+     ['-O'])
+
 # Tests that newArray/newArray_ is being optimised correctly
 
 test('T10359',
@@ -346,7 +366,7 @@ test('T7954',
      ['-O'])
 
 test('T7850',
-     [stats_num_field('peak_megabytes_allocated', 
+     [stats_num_field('peak_megabytes_allocated',
                       [(wordsize(32), 2, 10),
                        (wordsize(64), 4, 10)]),
       only_ways(['normal'])],
@@ -377,7 +397,7 @@ test('T4267',
 test('T7619',
      [stats_num_field('bytes allocated',
                       [ (wordsize(32), 36012, 10)
-                      # 32-bit close to 64-bit value; most of this very 
+                      # 32-bit close to 64-bit value; most of this very
                       # small number is standard start-up boilerplate I think
                       , (wordsize(64), 40992, 10) ]),
                       # previously, it was >400000 bytes
@@ -397,7 +417,7 @@ test('InlineByteArrayAlloc',
      [stats_num_field('bytes allocated',
                       [ (wordsize(32), 1360036012, 5)
                       , (wordsize(64), 1440040960, 5) ]),
-         # 32 and 64 bit not so different, because 
+         # 32 and 64 bit not so different, because
          # we are allocating *byte* arrays
       only_ways(['normal'])],
      compile_and_run,
@@ -405,7 +425,7 @@ test('InlineByteArrayAlloc',
 
 test('InlineCloneArrayAlloc',
      [stats_num_field('bytes allocated',
-                      [ (wordsize(32), 800041120, 5) 
+                      [ (wordsize(32), 800041120, 5)
                       , (wordsize(64), 1600041120, 5) ]),
       only_ways(['normal'])],
      compile_and_run,