<html xmlns:v="urn:schemas-microsoft-com:vml" xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:w="urn:schemas-microsoft-com:office:word" xmlns:m="http://schemas.microsoft.com/office/2004/12/omml" xmlns="http://www.w3.org/TR/REC-html40">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="Generator" content="Microsoft Word 15 (filtered medium)">
<style><!--
/* Font Definitions */
@font-face
{font-family:"Cambria Math";
panose-1:2 4 5 3 5 4 6 3 2 4;}
@font-face
{font-family:Calibri;
panose-1:2 15 5 2 2 2 4 3 2 4;}
/* Style Definitions */
p.MsoNormal, li.MsoNormal, div.MsoNormal
{margin:0cm;
margin-bottom:.0001pt;
font-size:12.0pt;
font-family:"Times New Roman",serif;}
a:link, span.MsoHyperlink
{mso-style-priority:99;
color:blue;
text-decoration:underline;}
a:visited, span.MsoHyperlinkFollowed
{mso-style-priority:99;
color:purple;
text-decoration:underline;}
p.Code, li.Code, div.Code
{mso-style-name:Code;
margin-top:0cm;
margin-right:0cm;
margin-bottom:0cm;
margin-left:36.0pt;
margin-bottom:.0001pt;
font-size:10.0pt;
font-family:"Courier New";}
p.msonormal0, li.msonormal0, div.msonormal0
{mso-style-name:msonormal;
mso-margin-top-alt:auto;
margin-right:0cm;
mso-margin-bottom-alt:auto;
margin-left:0cm;
font-size:12.0pt;
font-family:"Times New Roman",serif;}
span.EmailStyle19
{mso-style-type:personal-reply;
font-family:"Calibri",sans-serif;
color:windowtext;}
.MsoChpDefault
{mso-style-type:export-only;
font-family:"Calibri",sans-serif;
mso-fareast-language:EN-US;}
.MsoPapDefault
{mso-style-type:export-only;
margin-top:6.0pt;
margin-right:0cm;
margin-bottom:6.0pt;
margin-left:0cm;}
@page WordSection1
{size:612.0pt 792.0pt;
margin:72.0pt 72.0pt 72.0pt 72.0pt;}
div.WordSection1
{page:WordSection1;}
--></style><!--[if gte mso 9]><xml>
<o:shapedefaults v:ext="edit" spidmax="1026" />
</xml><![endif]--><!--[if gte mso 9]><xml>
<o:shapelayout v:ext="edit">
<o:idmap v:ext="edit" data="1" />
</o:shapelayout></xml><![endif]-->
</head>
<body lang="EN-GB" link="blue" vlink="purple">
<div class="WordSection1">
<p class="MsoNormal" style="margin-left:36.0pt">Long story short: learning and experimenting how GHC works and eventually contribute my findings (if any).<o:p></o:p></p>
<p class="MsoNormal"><o:p> </o:p></p>
<p class="MsoNormal">OK great! Let us know if you need help.<o:p></o:p></p>
<p class="MsoNormal"><br>
Simon<span style="font-size:11.0pt;font-family:"Calibri",sans-serif;mso-fareast-language:EN-US"><o:p></o:p></span></p>
<p class="MsoNormal"><a name="_MailEndCompose"><span style="font-size:11.0pt;font-family:"Calibri",sans-serif;mso-fareast-language:EN-US"><o:p> </o:p></span></a></p>
<span style="mso-bookmark:_MailEndCompose"></span>
<div style="border:none;border-left:solid blue 1.5pt;padding:0cm 0cm 0cm 4.0pt">
<div>
<div style="border:none;border-top:solid #E1E1E1 1.0pt;padding:3.0pt 0cm 0cm 0cm">
<p class="MsoNormal"><b><span lang="EN-US" style="font-size:11.0pt;font-family:"Calibri",sans-serif">From:</span></b><span lang="EN-US" style="font-size:11.0pt;font-family:"Calibri",sans-serif"> Alex Biehl [mailto:alex.biehl@gmail.com]
<br>
<b>Sent:</b> 25 January 2017 10:32<br>
<b>To:</b> Simon Peyton Jones <simonpj@microsoft.com><br>
<b>Cc:</b> ghc-devs@haskell.org<br>
<b>Subject:</b> Re: [commit: ghc] wip/discount-fv: Discount scrutinized free variables (fd9608e)<o:p></o:p></span></p>
</div>
</div>
<p class="MsoNormal"><o:p> </o:p></p>
<div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
I believe it was a false alarm. Unfortunately I could reproduce the reduced allocations even without my patch (I hadn't ran `validate` before, so I didn't know at that time). Ben was kind enough to push it to a branch so gipedia could pick up but it hadn't
any effect either. <o:p></o:p></p>
<div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<o:p> </o:p></p>
</div>
<div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
What leaves me wondering though why are the allocations reduced drastically (by ~30% for haddock.cabal and haddock.base and even ~57% for T9203. c.f.
<a href="https://ghc.haskell.org/trac/ghc/ticket/4960#comment:14">https://ghc.haskell.org/trac/ghc/ticket/4960#comment:14</a>). And not for others? I am using `./validate --testsuite-only --fast` (with a perf build GHC).<o:p></o:p></p>
</div>
<div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<o:p> </o:p></p>
</div>
<div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
The reason I did this was that I thought if I reduce `dupAppSize` in `CoreUtils` I could reduce code duplication in `case` expressions where GHC currently duplicates lots of alternatives (I only realized later that `dupAppSize` does not account for `case` expressions
at all, so its probably some case-of-case stuff or something) in some of my code and I wanted to confirm if that is actually a good thing. I noticed the ticket and though before tackling that I will try myself on that discount stuff. Long story short: learning
and experimenting how GHC works and eventually contribute my findings (if any).<o:p></o:p></p>
</div>
<div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<o:p> </o:p></p>
</div>
</div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<o:p> </o:p></p>
<div>
<div>
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
Simon Peyton Jones <<a href="mailto:simonpj@microsoft.com">simonpj@microsoft.com</a>> schrieb am Mi., 25. Jan. 2017 um 11:11 Uhr:<o:p></o:p></p>
</div>
<blockquote style="border:none;border-left:solid #CCCCCC 1.0pt;padding:0cm 0cm 0cm 6.0pt;margin-left:4.8pt;margin-right:0cm">
<p class="MsoNormal" style="mso-margin-top-alt:6.0pt;margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
Alex<br>
<br>
Interesting. Care to give us any background on what you are working on?<br>
<br>
I've often thought about discounting for free vars. Do you have some compelling examples?<br>
<br>
(Also fine if you just want to noodle privately for now.)<br>
<br>
Simon<br>
<br>
| -----Original Message-----<br>
| From: ghc-commits [mailto:<a href="mailto:ghc-commits-bounces@haskell.org" target="_blank">ghc-commits-bounces@haskell.org</a>] On Behalf Of<br>
| <a href="mailto:git@git.haskell.org" target="_blank">git@git.haskell.org</a><br>
| Sent: 24 January 2017 17:20<br>
| To: <a href="mailto:ghc-commits@haskell.org" target="_blank">ghc-commits@haskell.org</a><br>
| Subject: [commit: ghc] wip/discount-fv: Discount scrutinized free<br>
| variables (fd9608e)<br>
|<br>
| Repository : ssh://<a href="https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2Fgit%40git.haskell.org%2Fghc&data=02%7C01%7Csimonpj%40microsoft.com%7Caed78e8369f94b75d66a08d4450d6406%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636209371202035595&sdata=l5xJmng0a25tj5stOwHOvAv4kbW%2FbjPLosVpk5dYgvs%3D&reserved=0" target="_blank">git@git.haskell.org/ghc</a><br>
|<br>
| On branch : wip/discount-fv<br>
| Link :<br>
| <a href="https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2Fghc.haske" target="_blank">
https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2Fghc.haske</a><br>
| <a href="https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2Fll.org&data=02%7C01%7Csimonpj%40microsoft.com%7Caed78e8369f94b75d66a08d4450d6406%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636209371202055605&sdata=1RcKcmd6%2FeKlRwYwn2W0wNUQM7H9iMCyT0Vv1GznjLo%3D&reserved=0" target="_blank">
ll.org</a>%2Ftrac%2Fghc%2Fchangeset%2Ffd9608ea93fc2389907b82c3fe540805d986c28<br>
| e%2Fghc&data=02%7C01%7Csimonpj%<a href="https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2F40microsoft.com&data=02%7C01%7Csimonpj%40microsoft.com%7Caed78e8369f94b75d66a08d4450d6406%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636209371202055605&sdata=DI6gAH9d6JijQuhi3FQXMHc4oEFKVVFq0OcZRfnZq4s%3D&reserved=0" target="_blank">40microsoft.com</a>%7C6b18dd9581bc459c203b08d4<br>
| 447d482c%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636208752257772884&<br>
| sdata=3%2F1y5zQjDsa5j1%2FhTEjnKc4mg0qNtCD8WyqMaNUq5mA%3D&reserved=0<br>
|<br>
| >---------------------------------------------------------------<br>
|<br>
| commit fd9608ea93fc2389907b82c3fe540805d986c28e<br>
| Author: alexbiehl <<a href="mailto:alex.biehl@gmail.com" target="_blank">alex.biehl@gmail.com</a>><br>
| Date: Mon Jan 23 20:34:20 2017 +0100<br>
|<br>
| Discount scrutinized free variables<br>
|<br>
|<br>
| >---------------------------------------------------------------<br>
|<br>
| fd9608ea93fc2389907b82c3fe540805d986c28e<br>
| compiler/coreSyn/CoreUnfold.hs | 95 +++++++++++++++++++++++++-----------<br>
| ------<br>
| 1 file changed, 56 insertions(+), 39 deletions(-)<br>
|<br>
| diff --git a/compiler/coreSyn/CoreUnfold.hs<br>
| b/compiler/coreSyn/CoreUnfold.hs index 574d841..36ea382 100644<br>
| --- a/compiler/coreSyn/CoreUnfold.hs<br>
| +++ b/compiler/coreSyn/CoreUnfold.hs<br>
| @@ -62,8 +62,11 @@ import Bag<br>
| import Util<br>
| import Outputable<br>
| import ForeignCall<br>
| +import VarEnv<br>
|<br>
| +import Control.Applicative ((<|>))<br>
| import qualified Data.ByteString as BS<br>
| +import Debug.Trace<br>
|<br>
| {-<br>
| ************************************************************************<br>
| @@ -501,43 +504,51 @@ sizeExpr :: DynFlags<br>
| -- Note [Computing the size of an expression]<br>
|<br>
| sizeExpr dflags bOMB_OUT_SIZE top_args expr<br>
| - = size_up expr<br>
| + = size_up emptyInScopeSet expr<br>
| where<br>
| - size_up (Cast e _) = size_up e<br>
| - size_up (Tick _ e) = size_up e<br>
| - size_up (Type _) = sizeZero -- Types cost nothing<br>
| - size_up (Coercion _) = sizeZero<br>
| - size_up (Lit lit) = sizeN (litSize lit)<br>
| - size_up (Var f) | isRealWorldId f = sizeZero<br>
| + size_up :: InScopeSet -> CoreExpr -> ExprSize<br>
| + size_up is (Cast e _) = size_up is e<br>
| + size_up is (Tick _ e) = size_up is e<br>
| + size_up _ (Type _) = sizeZero -- Types cost nothing<br>
| + size_up _ (Coercion _) = sizeZero<br>
| + size_up _ (Lit lit) = sizeN (litSize lit)<br>
| + size_up _ (Var f) | isRealWorldId f = sizeZero<br>
| -- Make sure we get constructor discounts even<br>
| -- on nullary constructors<br>
| - | otherwise = size_up_call f [] 0<br>
| -<br>
| - size_up (App fun arg)<br>
| - | isTyCoArg arg = size_up fun<br>
| - | otherwise = size_up arg `addSizeNSD`<br>
| - size_up_app fun [arg] (if isRealWorldExpr arg<br>
| then 1 else 0)<br>
| -<br>
| - size_up (Lam b e)<br>
| - | isId b && not (isRealWorldId b) = lamScrutDiscount dflags<br>
| (size_up e `addSizeN` 10)<br>
| - | otherwise = size_up e<br>
| -<br>
| - size_up (Let (NonRec binder rhs) body)<br>
| - = size_up rhs `addSizeNSD`<br>
| - size_up body `addSizeN`<br>
| + | otherwise = size_up_call f [] 0<br>
| +<br>
| + size_up is (App fun arg)<br>
| + | isTyCoArg arg = size_up is fun<br>
| + | otherwise = size_up is arg `addSizeNSD`<br>
| + size_up_app is fun [arg] (if isRealWorldExpr<br>
| + arg then 1 else 0)<br>
| +<br>
| + size_up is (Lam b e)<br>
| + | isId b && not (isRealWorldId b) = lamScrutDiscount dflags<br>
| (size_up is e `addSizeN` 10)<br>
| + | otherwise = size_up is e<br>
| +<br>
| + size_up is (Let (NonRec binder rhs) body)<br>
| + = let<br>
| + is' = extendInScopeSet is binder<br>
| + in<br>
| + size_up is rhs `addSizeNSD`<br>
| + size_up is' body `addSizeN`<br>
| (if isUnliftedType (idType binder) then 0 else 10)<br>
| -- For the allocation<br>
| -- If the binder has an unlifted type there is no<br>
| allocation<br>
|<br>
| - size_up (Let (Rec pairs) body)<br>
| - = foldr (addSizeNSD . size_up . snd)<br>
| - (size_up body `addSizeN` (10 * length pairs)) --<br>
| (length pairs) for the allocation<br>
| + size_up is (Let (Rec pairs) body)<br>
| + = let<br>
| + is' = extendInScopeSetList is (map fst pairs)<br>
| + in<br>
| + foldr (addSizeNSD . size_up is' . snd)<br>
| + (size_up is' body<br>
| + `addSizeN` (10 * length pairs)) -- (length pairs)<br>
| for the allocation<br>
| pairs<br>
|<br>
| - size_up (Case e _ _ alts)<br>
| - | Just v <- is_top_arg e -- We are scrutinising an argument<br>
| variable<br>
| + size_up is (Case e _ _ alts)<br>
| + | Just v <- is_top_arg e <|> is_free_var e -- We are<br>
| + scrutinising an argument variable or a free variable<br>
| = let<br>
| - alt_sizes = map size_up_alt alts<br>
| + alt_sizes = map (size_up_alt is) alts<br>
|<br>
| -- alts_size tries to compute a good discount for<br>
| -- the case when we are scrutinising an argument<br>
| variable @@ -569,9 +580,12 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr<br>
| is_top_arg (Cast e _) = is_top_arg e<br>
| is_top_arg _ = Nothing<br>
|<br>
| + is_free_var (Var v) | not (v `elemInScopeSet` is) = Just v<br>
| + is_free_var (Cast e _) = is_free_var e<br>
| + is_free_var _ = Nothing<br>
|<br>
| - size_up (Case e _ _ alts) = size_up e `addSizeNSD`<br>
| - foldr (addAltSize . size_up_alt)<br>
| case_size alts<br>
| + size_up is (Case e _ _ alts) = size_up is e `addSizeNSD`<br>
| + foldr (addAltSize . size_up_alt is)<br>
| + case_size alts<br>
| where<br>
| case_size<br>
| | is_inline_scrut e, not (lengthExceeds alts 1) = sizeN (-<br>
| 10) @@ -608,15 +622,15 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr<br>
|<br>
| ------------<br>
| -- size_up_app is used when there's ONE OR MORE value args<br>
| - size_up_app (App fun arg) args voids<br>
| - | isTyCoArg arg = size_up_app fun args voids<br>
| - | isRealWorldExpr arg = size_up_app fun (arg:args)<br>
| (voids + 1)<br>
| - | otherwise = size_up arg `addSizeNSD`<br>
| - size_up_app fun (arg:args)<br>
| voids<br>
| - size_up_app (Var fun) args voids = size_up_call fun args voids<br>
| - size_up_app (Tick _ expr) args voids = size_up_app expr args voids<br>
| - size_up_app (Cast expr _) args voids = size_up_app expr args voids<br>
| - size_up_app other args voids = size_up other `addSizeN`<br>
| + size_up_app is (App fun arg) args voids<br>
| + | isTyCoArg arg = size_up_app is fun args voids<br>
| + | isRealWorldExpr arg = size_up_app is fun (arg:args)<br>
| (voids + 1)<br>
| + | otherwise = size_up is arg `addSizeNSD`<br>
| + size_up_app is fun (arg:args)<br>
| voids<br>
| + size_up_app _ (Var fun) args voids = size_up_call fun args<br>
| voids<br>
| + size_up_app is (Tick _ expr) args voids = size_up_app is expr args<br>
| voids<br>
| + size_up_app is (Cast expr _) args voids = size_up_app is expr args<br>
| voids<br>
| + size_up_app is other args voids = size_up is other<br>
| `addSizeN`<br>
| callSize (length args) voids<br>
| -- if the lhs is not an App or a Var, or an invisible thing like<br>
| a<br>
| -- Tick or Cast, then we should charge for a complete call plus<br>
| the @@ -633,7 +647,10 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr<br>
| _ -> funSize dflags top_args fun (length<br>
| val_args) voids<br>
|<br>
| ------------<br>
| - size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10<br>
| + size_up_alt :: InScopeSet -> Alt Var -> ExprSize<br>
| + size_up_alt is (_con, bndrs, rhs) = size_up is' rhs `addSizeN` 10<br>
| + where is' = extendInScopeSetList is bndrs<br>
| +<br>
| -- Don't charge for args, so that wrappers look cheap<br>
| -- (See comments about wrappers with Case)<br>
| --<br>
|<br>
| _______________________________________________<br>
| ghc-commits mailing list<br>
| <a href="mailto:ghc-commits@haskell.org" target="_blank">ghc-commits@haskell.org</a><br>
| <a href="https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.hask" target="_blank">
https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.hask</a><br>
| <a href="https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2Fell.org&data=02%7C01%7Csimonpj%40microsoft.com%7Caed78e8369f94b75d66a08d4450d6406%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636209371202055605&sdata=IWRk1wqqENc614l5qjal8TvaUKI0UWqDRkRda2RZkiA%3D&reserved=0" target="_blank">
ell.org</a>%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc-<br>
| commits&data=02%7C01%7Csimonpj%<a href="https://na01.safelinks.protection.outlook.com/?url=http%3A%2F%2F40microsoft.com&data=02%7C01%7Csimonpj%40microsoft.com%7Caed78e8369f94b75d66a08d4450d6406%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636209371202055605&sdata=DI6gAH9d6JijQuhi3FQXMHc4oEFKVVFq0OcZRfnZq4s%3D&reserved=0" target="_blank">40microsoft.com</a>%7C6b18dd9581bc459c203b08d4<br>
| 447d482c%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636208752257772884&<br>
| sdata=rGeUVlgqjfwCl%2FEdTX3%2BX0mQGX5UcS7bY9qadLT%2FSE4%3D&reserved=0<o:p></o:p></p>
</blockquote>
</div>
</div>
</div>
</body>
</html>