Commit b06e457d authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Marge Bot

Make specialisation a bit more aggressive

The patch

    commit c43c9817
    Author: Simon Peyton Jones <simonpj@microsoft.com>
    Date:   Fri Oct 23 16:15:51 2009 +0000
    Fix Trac #3591: very tricky specialiser bug

fixed a nasty specialisation bug /for DFuns/.  Eight years
later, this patch

    commit 2b74bd9d
    Author: Simon Peyton Jones <simonpj@microsoft.com>
    Date:   Wed Jun 7 12:03:51 2017 +0100
    Stop the specialiser generating loopy code

extended it to work for /imported/ DFuns.  But in the process
we lost the fact that it was needed only for DFuns! As a result
we started silently losing useful specialisation for non-DFuns.
But there was no regression test to spot the lossage.

Then, nearly four years later, Andreas filed #19599, which showed
the lossage in high relief.  This patch restores the DFun test,
and adds Note [Avoiding loops (non-DFuns)] to explain why.

This is undoubtedly a very tricky corner of the specialiser,
and one where I would love to have a more solid argument, even a
paper!  But meanwhile I think this fixes the lost specialisations
without introducing any new loops.

I have two regression tests, T19599 and T19599a, so I hope we'll
know if we lose them again in the future.

Vanishingly small effect on nofib.

A couple of compile-time benchmarks improve
  T9872a(normal) ghc/alloc  1660559328.0  1643827784.0  -1.0% GOOD
  T9872c(normal) ghc/alloc  1691359152.0  1672879384.0  -1.1% GOOD
Many others wiggled around a bit.

Metric Decrease:
    T9872a
    T9872c
parent 2e3a6fba
Pipeline #34057 canceled with stages
in 33 seconds
......@@ -859,14 +859,14 @@ allows DFuns to specialise as well.
Note [Avoiding loops in specImports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We must take great care when specialising instance declarations
(functions like $fOrdList) lest we accidentally build a recursive
dictionary. See Note [Avoiding loops].
(DFuns like $fOrdList) lest we accidentally build a recursive
dictionary. See Note [Avoiding loops (DFuns)].
The basic strategy of Note [Avoiding loops] is to use filterCalls
The basic strategy of Note [Avoiding loops (DFuns)] is to use filterCalls
to discard loopy specialisations. But to do that we must ensure
that the in-scope dict-binds (passed to filterCalls) contains
all the needed dictionary bindings. In particular, in the recursive
call to spec_imorpts in spec_import, we must include the dict-binds
call to spec_imports in spec_import, we must include the dict-binds
from the parent. Lacking this caused #17151, a really nasty bug.
Here is what happened.
......@@ -1820,8 +1820,8 @@ In general, we need only make this Rec if
- there are some specialisations (spec_binds non-empty)
- there are some dict_binds that depend on f (dump_dbs non-empty)
Note [Avoiding loops]
~~~~~~~~~~~~~~~~~~~~~
Note [Avoiding loops (DFuns)]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When specialising /dictionary functions/ we must be very careful to
avoid building loops. Here is an example that bit us badly, on
several distinct occasions.
......@@ -1862,8 +1862,10 @@ Solution:
(directly or indirectly) on the dfun we are specialising.
This is done by 'filterCalls'
--------------
Here's yet another example
Note [Avoiding loops (non-DFuns)]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The whole Note [Avoiding loops (DFuns)] things applies only to DFuns.
It's important /not/ to apply filterCalls to non-DFuns. For example:
class C a where { foo,bar :: [a] -> [a] }
......@@ -1884,8 +1886,8 @@ That translates to:
The call (r_bar $fCInt) mentions $fCInt,
which mentions foo_help,
which mentions r_bar
But we DO want to specialise r_bar at Int:
But we DO want to specialise r_bar at Int:
Rec { $fCInt :: C Int = MkC foo_help reverse
foo_help (xs::[Int]) = r_bar Int $fCInt xs
......@@ -1897,6 +1899,22 @@ But we DO want to specialise r_bar at Int:
Note that, because of its RULE, r_bar joins the recursive
group. (In this case it'll unravel a short moment later.)
See test simplCore/should_compile/T19599a.
Another example is #19599, which looked like this:
class (Show a, Enum a) => MyShow a where
myShow :: a -> String
myShow_impl :: MyShow a => a -> String
foo :: Int -> String
foo = myShow_impl @Int $fMyShowInt
Rec { $fMyShowInt = MkMyShowD $fEnumInt $fShowInt $cmyShow
; $cmyShow = myShow_impl @Int $fMyShowInt }
Here, we really do want to specialise `myShow_impl @Int $fMyShowInt`.
Note [Specialising a recursive group]
......@@ -2677,11 +2695,10 @@ pair_fvs (bndr, rhs) = exprSomeFreeVars interesting rhs
interesting :: InterestingVarFun
interesting v = isLocalVar v || (isId v && isDFunId v)
-- Very important: include DFunIds /even/ if it is imported
-- Reason: See Note [Avoiding loops], the second example
-- involving an imported dfun. We must know whether
-- a dictionary binding depends on an imported dfun,
-- in case we try to specialise that imported dfun
-- #13429 illustrates
-- Reason: See Note [Avoiding loops in specImports], the #13429
-- example involving an imported dfun. We must know
-- whether a dictionary binding depends on an imported
-- DFun in case we try to specialise that imported DFun
-- | Flatten a set of "dumped" 'DictBind's, and some other binding
-- pairs, into a single recursive binding.
......@@ -2771,14 +2788,19 @@ callsForMe fn (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
Nothing -> []
Just cis -> filterCalls cis orig_dbs
-- filterCalls: drop calls that (directly or indirectly)
-- refer to fn. See Note [Avoiding loops]
-- refer to fn. See Note [Avoiding loops (DFuns)]
----------------------
filterCalls :: CallInfoSet -> Bag DictBind -> [CallInfo]
-- See Note [Avoiding loops]
-- See Note [Avoiding loops (DFuns)]
filterCalls (CIS fn call_bag) dbs
= filter ok_call (bagToList call_bag)
| isDFunId fn -- Note [Avoiding loops (DFuns)] applies only to DFuns
= filter ok_call unfiltered_calls
| otherwise -- Do not apply it to non-DFuns
= unfiltered_calls -- See Note [Avoiding loops (non-DFuns)]
where
unfiltered_calls = bagToList call_bag
dump_set = foldl' go (unitVarSet fn) dbs
-- This dump-set could also be computed by splitDictBinds
-- (_,_,dump_set) = splitDictBinds dbs {fn}
......
module SPEC where
class (Show a, Enum a) => MyShow a where
myShow :: a -> String
instance MyShow Int where
myShow = myShow_impl . succ
foo :: Int -> String
foo = myShow_impl
-- This pragma should not be necessary
-- {-# specialize myShow_impl :: Int -> String #-}
{-# INLINEABLE myShow_impl #-}
myShow_impl :: MyShow a => a -> String
-- Make it large enough not to inline
myShow_impl x = show . succ . succ . succ . succ . succ . succ .
succ . succ . succ . succ . succ . succ . succ .
succ . succ . succ $ x
==================== Tidy Core rules ====================
"SPEC myShow_impl @Int"
forall ($dMyShow :: MyShow Int). myShow_impl @Int $dMyShow = foo
module Spec where
class C a where { foo,bar :: [a] -> [a] }
instance C Int where
foo x = r_bar x
bar xs = reverse xs
r_bar :: C a => [a] -> [a]
r_bar (x:xs) = bar (xs ++ r_bar xs)
r_bar [] = []
-- We should specialise `r_bar` at Int
-- C.f. Note Note [Avoiding loops (non-DFuns)] in GHC.Core.Opt.Specialise
==================== Tidy Core rules ====================
"SPEC r_bar @Int"
forall ($dC :: C Int). r_bar @Int $dC = $fCInt_$sr_bar
......@@ -351,3 +351,6 @@ test('T19360', only_ways(['optasm']), compile, [''])
# If the test goes wrong we'll get more case expressions in the output
test('T19581', [ grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T19599', normal, compile, ['-O -ddump-rules'])
test('T19599a', normal, compile, ['-O -ddump-rules'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment