Commit 89834d6d authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Add -fcross-module-specialise flag

Summary:
As of 7.10.1 we specialize INLINEABLE identifiers defined in other
modules. This can expose issues (compiler bugs or otherwise) in some cases
(e.g. Trac #10491) and therefore we now provide a way for the user to disable
this optimization.

Test Plan: Successfully compile Splice.hs from Trac #10491.

Reviewers: simonpj, austin

Reviewed By: simonpj

Subscribers: simonpj, thomie, bgamari

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

GHC Trac Issues: #10491
parent f2ffdc6e
......@@ -342,6 +342,7 @@ data GeneralFlag
| Opt_FloatIn
| Opt_Specialise
| Opt_SpecialiseAggressively
| Opt_CrossModuleSpecialise
| Opt_StaticArgumentTransformation
| Opt_CSE
| Opt_LiberateCase
......@@ -2990,6 +2991,7 @@ fFlags = [
flagSpec "spec-constr" Opt_SpecConstr,
flagSpec "specialise" Opt_Specialise,
flagSpec "specialise-aggressively" Opt_SpecialiseAggressively,
flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise,
flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation,
flagSpec "strictness" Opt_Strictness,
flagSpec "use-rpaths" Opt_RPath,
......@@ -3314,6 +3316,7 @@ optLevelFlags -- see Note [Documenting optimisation flags]
, ([1,2], Opt_IgnoreAsserts)
, ([1,2], Opt_Loopification)
, ([1,2], Opt_Specialise)
, ([1,2], Opt_CrossModuleSpecialise)
, ([1,2], Opt_Strictness)
, ([1,2], Opt_UnboxSmallStrictFields)
......
......@@ -571,6 +571,7 @@ Hence, the invariant is this:
************************************************************************
-}
-- | Specialise calls to type-class overloaded functions occuring in a program.
specProgram :: ModGuts -> CoreM ModGuts
specProgram guts@(ModGuts { mg_module = this_mod
, mg_rules = local_rules
......@@ -583,10 +584,18 @@ specProgram guts@(ModGuts { mg_module = this_mod
-- Specialise imported functions
; hpt_rules <- getRuleBase
; let rule_base = extendRuleBaseList hpt_rules local_rules
; (new_rules, spec_binds) <- specImports dflags this_mod emptyVarSet rule_base uds
; let final_binds | null spec_binds = binds'
| otherwise = Rec (flattenBinds spec_binds) : binds'
; (new_rules, spec_binds) <- specImports dflags this_mod emptyVarSet
rule_base (ud_calls uds)
-- Don't forget to wrap the specialized bindings with bindings
-- for the needed dictionaries.
-- See Note [Wrap bindings returned by specImports]
; let spec_binds' = wrapDictBinds (ud_binds uds) spec_binds
; let final_binds
| null spec_binds' = binds'
| otherwise = Rec (flattenBinds spec_binds') : binds'
-- Note [Glom the bindings if imported functions are specialised]
; return (guts { mg_binds = final_binds
......@@ -606,20 +615,49 @@ specProgram guts@(ModGuts { mg_module = this_mod
(bind', uds') <- specBind top_subst bind uds
return (bind' ++ binds', uds')
{-
Note [Wrap bindings returned by specImports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'specImports' returns a set of specialized bindings. However, these are lacking
necessary floated dictionary bindings, which are returned by
UsageDetails(ud_binds). These dictionaries need to be brought into scope with
'wrapDictBinds' before the bindings returned by 'specImports' can be used. See,
for instance, the 'specImports' call in 'specProgram'.
Note [Disabling cross-module specialisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Since GHC 7.10 we have performed specialisation of INLINEABLE bindings living
in modules outside of the current module. This can sometimes uncover user code
which explodes in size when aggressively optimized. The
-fno-cross-module-specialise option was introduced to allow users to being
bitten by such instances to revert to the pre-7.10 behavior.
See Trac #10491
-}
-- | Specialise a set of calls to imported bindings
specImports :: DynFlags
-> Module
-> VarSet -- Don't specialise these ones
-- See Note [Avoiding recursive specialisation]
-> RuleBase -- Rules from this module and the home package
-- (but not external packages, which can change)
-> UsageDetails -- Calls for imported things, and floating bindings
-> CallDetails -- Calls for imported things, and floating bindings
-> CoreM ( [CoreRule] -- New rules
, [CoreBind] ) -- Specialised bindings and floating bindings
specImports dflags this_mod done rule_base uds
= do { let import_calls = varEnvElts (ud_calls uds)
, [CoreBind] ) -- Specialised bindings
-- See Note [Wrapping bindings returned by specImports]
specImports dflags this_mod done rule_base cds
-- See Note [Disabling cross-module specialisation]
| not $ gopt Opt_CrossModuleSpecialise dflags =
return ([], [])
| otherwise =
do { let import_calls = varEnvElts cds
; (rules, spec_binds) <- go rule_base import_calls
; return (rules, wrapDictBinds (ud_binds uds) spec_binds) }
; return (rules, spec_binds) }
where
go :: RuleBase -> [CallInfoSet] -> CoreM ([CoreRule], [CoreBind])
go _ [] = return ([], [])
go rb (CIS fn calls_for_fn : other_calls)
= do { (rules1, spec_binds1) <- specImport dflags this_mod done rb fn $
......@@ -666,9 +704,15 @@ specImport dflags this_mod done rb fn calls_for_fn
; (rules2, spec_binds2) <- -- pprTrace "specImport" (ppr fn $$ ppr uds $$ ppr rhs) $
specImports dflags this_mod (extendVarSet done fn)
(extendRuleBaseList rb rules1)
uds
(ud_calls uds)
-- Don't forget to wrap the specialized bindings with bindings
-- for the needed dictionaries
-- See Note [Wrap bindings returned by specImports]
; let final_binds = wrapDictBinds (ud_binds uds)
(spec_binds2 ++ spec_binds1)
; return (rules2 ++ rules1, spec_binds2 ++ spec_binds1) }
; return (rules2 ++ rules1, final_binds) }
| otherwise
= WARN( True, hang (ptext (sLit "specImport discarding:") <+> ppr fn <+> dcolon <+> ppr (idType fn))
......
......@@ -2162,6 +2162,13 @@
<entry><option>-fno-specialise</option></entry>
</row>
<row>
<entry><option>-fcross-module-specialise</option></entry>
<entry>Turn on specialisation of overloaded functions imported from other modules.</entry>
<entry>dynamic</entry>
<entry><option>-fno-cross-module-specialise</option></entry>
</row>
<row>
<entry><option>-fstatic-argument-transformation</option></entry>
<entry>Turn on the static argument transformation.</entry>
......
......@@ -2936,10 +2936,25 @@ foldl f z (Stream step s _) = foldl_loop SPEC z s
<listitem>
<para><emphasis>On by default.</emphasis>
Specialise each type-class-overloaded function defined in this
module for the types at which it is called in this module. Also
specialise imported functions that have an INLINABLE pragma
(<xref linkend="inlinable-pragma"/>) for the types at which they
are called in this module.
module for the types at which it is called in this module. If
<literal>-fcross-module-specialise</literal> is set imported
functions that have an INLINABLE pragma
(<xref linkend="inlinable-pragma"/>) will be specialised as well.
</para>
</listitem>
</varlistentry>
<varlistentry>
<term>
<option>-fcross-module-specialise</option>
<indexterm><primary><option>-fcross-module-specialise</option></primary></indexterm>
</term>
<listitem>
<para><emphasis>On by default.</emphasis>
Specialise <literal>INLINABLE</literal> (<xreg linked="inlinable-pragma"/>)
type-class-overloaded functions imported from other modules for the
types at which they are called in this module. Note that specialisation must
be enabled (by <literal>-fspecialise</literal>) for this to have any effect.
</para>
</listitem>
</varlistentry>
......
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