Commit 85e16365 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Inline implication constraints

This patch fixes Trac #1643, where Lennart found that GHC was generating
code with unnecessary dictionaries.  The reason was that we were getting
an implication constraint floated out of an INLINE (actually an instance
decl), and the implication constraint therefore wasn't inlined even 
though it was used only once (but inside the INLINE).  Thus we were 
getting:

	ic = \d -> <stuff>
	foo = _inline_me_ (...ic...)

Then 'foo' gets inlined in lots of places, but 'ic' now looks a bit 
big.  

But implication constraints should *always* be inlined; they are just
artefacts of the constraint simplifier.

This patch solves the problem, by adding a WpInline form to the HsWrap
type. 
parent 34429d31
......@@ -463,6 +463,8 @@ dsCoercion (WpApp id) thing_inside = do { expr <- thing_inside
; return (App expr (Var id)) }
dsCoercion (WpTyApp ty) thing_inside = do { expr <- thing_inside
; return (App expr (Type ty)) }
dsCoercion WpInline thing_inside = do { expr <- thing_inside
; return (mkInlineMe expr) }
dsCoercion (WpLet bs) thing_inside = do { prs <- dsLHsBinds bs
; expr <- thing_inside
; return (Let (Rec prs) expr) }
......
......@@ -345,6 +345,7 @@ data HsWrapper
| WpTyApp Type -- [] t the 't' is a type or corecion
| WpLam Id -- \d. [] the 'd' is a type-class dictionary
| WpTyLam TyVar -- \a. [] the 'a' is a type or coercion variable
| WpInline -- inline_me [] Wrap inline around the thing
-- Non-empty bindings, so that the identity coercion
-- is always exactly WpHole
......@@ -365,6 +366,7 @@ pprHsWrapper it wrap =
help it (WpLam id) = sep [ptext SLIT("\\") <> pprBndr LambdaBind id <> dot, it]
help it (WpTyLam tv) = sep [ptext SLIT("/\\") <> pprBndr LambdaBind tv <> dot, it]
help it (WpLet binds) = sep [ptext SLIT("let") <+> braces (ppr binds), it]
help it WpInline = sep [ptext SLIT("_inline_me_"), it]
in
-- in debug mode, print the wrapper
-- otherwise just print what's inside
......
......@@ -543,7 +543,8 @@ zonk_cmd_top env (HsCmdTop cmd stack_tys ty ids)
-------------------------------------------------------------------------
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn env WpHole = return (env, WpHole)
zonkCoFn env WpHole = return (env, WpHole)
zonkCoFn env WpInline = return (env, WpInline)
zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1
; (env2, c2') <- zonkCoFn env1 c2
; return (env2, WpCompose c1' c2') }
......
......@@ -1014,7 +1014,9 @@ makeImplicationBind loc all_tvs reft
tup_ty = mkTupleTy Boxed n_dict_irreds (map idType dict_irred_ids)
pat = TuplePat (map nlVarPat dict_irred_ids) Boxed tup_ty
rhs = L span (mkHsWrap co (HsVar (instToId implic_inst)))
co = mkWpApps (map instToId dict_givens) <.> mkWpTyApps eq_tyvar_cos <.> mkWpTyApps (mkTyVarTys all_tvs)
co = mkWpApps (map instToId dict_givens)
<.> mkWpTyApps eq_tyvar_cos
<.> mkWpTyApps (mkTyVarTys all_tvs)
bind | [dict_irred_id] <- dict_irred_ids = VarBind dict_irred_id rhs
| otherwise = PatBind { pat_lhs = L span pat,
pat_rhs = unguardedGRHSs rhs,
......@@ -2216,8 +2218,13 @@ reduceImplication env orig_avails name reft tvs extra_givens wanteds inst_loc
-- SLPJ Sept07: this looks Utterly Wrong to me, but I think
-- that current extra_givens has no EqInsts, so
-- it makes no difference
-- dict_ids = map instToId extra_givens
co = mkWpTyLams tvs <.> mkWpTyLams eq_tyvars <.> mkWpLams dict_ids <.> WpLet (binds `unionBags` bind)
co = wrap_inline -- Note [Always inline implication constraints]
<.> mkWpTyLams tvs
<.> mkWpTyLams eq_tyvars
<.> mkWpLams dict_ids
<.> WpLet (binds `unionBags` bind)
wrap_inline | null dict_ids = idHsWrapper
| otherwise = WpInline
rhs = mkHsWrap co payload
loc = instLocSpan inst_loc
payload | [dict_wanted] <- dict_wanteds = HsVar (instToId dict_wanted)
......@@ -2232,6 +2239,16 @@ reduceImplication env orig_avails name reft tvs extra_givens wanteds inst_loc
}
\end{code}
Note [Always inline implication constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose an implication constraint floats out of an INLINE function.
Then although the implication has a single call site, it won't be
inlined. And that is bad because it means that even if there is really
*no* overloading (type signatures specify the exact types) there will
still be dictionary passing in the resulting code. To avert this,
we mark the implication constraints themselves as INLINE, at least when
there is no loss of sharing as a result.
Note [Reducing implication constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we are trying to simplify
......
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