<p dir="ltr">Yep, that's the current question: why does preferring `EvCoercion (TransCo UnivCo (TransCo co UnivCo))` to `EvCast (EvCoercion co) UnivCo` seem to matter? In my scenario, `co` is the evidence for a Given equality type. And the coercion I'm building is also a Given constraint's evidence -- I'm simplifying Givens.</p>
<p dir="ltr">The only hard indication I currently have of what "goes wrong" is the ASSERT failure described in the previous email.</p>
<p dir="ltr">I'm planning to spend some time investigating. I would appreciate any cycles you spend on it!</p>
<br><div class="gmail_quote"><div dir="ltr">On Sun, Oct 8, 2017, 18:53 Richard Eisenberg <<a href="mailto:rae@cs.brynmawr.edu">rae@cs.brynmawr.edu</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div style="word-wrap:break-word"><div>Thanks for this status report. If I'm to boil it down to the question you seem to be asking: What does changing EvCast ... to EvCoercion ... fix the problem? I'm not sure of the answer at this point, but I want to make sure I understand the question before I go digging for an answer. It's always possible a Note is wrong!</div><div><br></div><div>Thanks for this!</div></div><div style="word-wrap:break-word"><div><br></div><div>Richard</div><br></div><div style="word-wrap:break-word"><div><blockquote type="cite"><div>On Oct 7, 2017, at 8:19 PM, Nicolas Frisby <<a href="mailto:nicolas.frisby@gmail.com" target="_blank">nicolas.frisby@gmail.com</a>> wrote:</div><br class="m_637828321027685404Apple-interchange-newline"></blockquote></div></div><div style="word-wrap:break-word"><div><blockquote type="cite"><div><div dir="ltr">I can happily report some progress: I'm seeing no more Core lint errors!<div><br></div><div>1) Thank you both Richard and Simon for your pointers -- <span style="color:rgb(33,33,33);font-family:Calibri,sans-serif;font-size:14.6667px">-fprint-typechecker-</span><span style="color:rgb(33,33,33);font-family:Calibri,sans-serif;font-size:14.6667px">elaboration</span> in particular was a revelation.</div><div><br></div><div>2) Simon, I intend to match the spirit of the favor you requested, but not to the letter. My goal with this project is to write a typechecker plugin for achieving row types _without_ editing GHC's source code. I'm keeping an annotated bibliography of things I've studied (papers, guide/wiki/blog, source Notes, etc). (It's nice to put a bunch of related notes in the same text file!) I'm also logging my epiphanies, which I do intend to write-up in some kind of document (probably on the dev wiki). I'm planning a section for suggesting which Notes should be adjusted/expanded, but I don't anticipate feeling comfortable enough to actually edit the Notes myself. This is unfortunately just a hobby project. My intent is to offer you, Richard, and other experts the details of what wasn't clear to me.</div><div><br></div><div>3) I confirmed that the lack of cobox uniques in the dump output was indeed due to `ppr_co' deferring to `ppr @IfaceType'; it does that (at least) for every coercion with a head of `TyConAppCo'. With a tiny kludgy patch I was able to persist those uniques just for debugging purposes.</div><div><br></div><div>4) My top-level error is an "out of scope cobox" Lint error, but (once I patched the dumper) the output of <span style="color:rgb(33,33,33);font-family:Calibri,sans-serif;font-size:14.6667px">-fprint-typechecker-</span><span style="color:rgb(33,33,33);font-family:Calibri,sans-serif;font-size:14.6667px">elaboration</span> showed sufficient bindings for all of the cobox occurrences, even the one that the Lint error was flagging! Stymied, I finally did a -DDEBUG build of the ghc-8.2.2-rc1 tag and used that. It ultimately lead to me finding my mistakes. (New wisdom: always use a DEBUG build when authoring a plugin. (... Duh.))</div><div><br></div><div>4a) ASSERT failures showed that I was invoking `substTy' without correctly initializing the `InScopeSet'. I also was ignorant that I should be using `extendTvSubstAndInScope' instead of just `extendTvSubst'. I don't think this was relevant to my particular Lint error, but I fixed it if only to see further ASSERT failures.<br><br>4b) Fixing my `InScopeSet's ASSERT failure revealed another: `extendIdSubst' was being called with a CoVar! That's something that my plugin code absolutely does not do, so at that point I knew that some higher-level operation I was doing was knocking the rest of GHC's pipeline off the rails. (In particular, I traced this ASSERT callstack to extendIdSubst called from simpleOptExpr called from mkInlineUnfoldingWithArity called from DsBinds. I stopped there.)</div><div><br></div><div>5) The first suspect turned out to be the culprit: I was using my plugin's by-fiat coercions in the most naive possible way, always simply `EvCast ev (fiatCoercion ty0 ty1)`. In particular, I was even doing that to create new Given unlifted equality witnesses from existing Given unlifted equality witnesses when simplifying Given constraints (e.g. for example reducing a plugin-specific type family application on one side of an unlifted equality type ~#).<br><br>In summary, I see no more ASSERT failures or Lint errors having now changed my plugin to prefer `EvCoercion (TransCo U (TransCo co U))` to `EvCast (EvCoercion co) U`. The actual diff excerpt is here: <a href="https://github.com/nfrisby/coxswain/issues/3#issuecomment-334972227" target="_blank">https://github.com/nfrisby/coxswain/issues/3#issuecomment-334972227</a><br></div><div><br></div><div>I have not figured out exactly why that change matters, but it does seem a reasonable preference to require. In particular, Note [Coercion evidence terms] in TcEvidence.hs explicitly says that `EvCast (EvCoercion co1) co2` is a valid form of evidence for ~#. So perhaps that Note deserves elaboration --- I'm guessing the missing part may be specific to Givens?</div><div><br></div><div>-Nick</div></div><br><div class="gmail_quote"><div dir="ltr">On Thu, Sep 21, 2017 at 2:59 AM Simon Peyton Jones <<a href="mailto:simonpj@microsoft.com" target="_blank">simonpj@microsoft.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">





<div lang="EN-GB" link="blue" vlink="purple">
<div class="m_637828321027685404m_-3607345558727168865WordSection1"><p class="MsoNormal"><span style="font-size:12.0pt">Some thoughts<u></u><u></u></span></p><p class="MsoNormal"><span style="font-size:12.0pt"><u></u> <u></u></span></p>
<ul style="margin-top:0cm" type="disc">
<li class="m_637828321027685404m_-3607345558727168865MsoListParagraph" style="margin-left:0cm"><span style="font-size:12.0pt">Read Note [Coercion holes] in TyCoRep.<u></u><u></u></span></li></ul><p class="m_637828321027685404m_-3607345558727168865MsoListParagraph"><span style="font-size:12.0pt"><u></u> <u></u></span></p>
<ul style="margin-top:0cm" type="disc">
<li class="m_637828321027685404m_-3607345558727168865MsoListParagraph" style="margin-left:0cm"><span style="font-size:12.0pt">As you’ll see, generally we don’t create value-bindings for (unboxed) coercions of type t1 ~# t2.  (yes for boxed ones t1 ~ t2).     Reasons in the Note. 
 Exception: for superclasses of Givens we do create    (co :: a ~# b) = sc_sel1 d<u></u><u></u></span></li></ul><p class="m_637828321027685404m_-3607345558727168865MsoListParagraph"><span style="font-size:12.0pt">where d is some dictionary with a superclass of type (a ~# b).<u></u><u></u></span></p><p class="MsoNormal"><span style="font-size:12.0pt"><u></u> <u></u></span></p><p class="MsoNormal" style="margin-left:36.0pt"><span style="font-size:12.0pt">Side note: the use of “cobox” is wildly unhelpful.  These Ids are specifically
<b>unboxed</b>!  I’m going to change it to just “co”.<u></u><u></u></span></p><p class="MsoNormal" style="margin-left:36.0pt"><span style="font-size:12.0pt"><u></u> <u></u></span></p>
<ul style="margin-top:0cm" type="disc">
<li class="m_637828321027685404m_-3607345558727168865MsoListParagraph" style="margin-left:0cm">You appear to have bindings like[G]  cobox_a67J = CO Sym cobox_a654.  That is suspicious.  Who is creating them?  It may not actually be wrong but it’s suspicious.  The time it’d be
 outright wrong is if you dropped the ev-binds on the floor.<u></u><u></u></li></ul><p class="MsoNormal"><u></u> <u></u></p><p class="MsoNormal" style="margin-left:36.0pt">Ha!  runTcSEqualites makes up an ev_binds_var, and solves the equalities – but it should be the case that no value bindings end up in the ev_binds_var.  (reason: we are solving equalities in a type signature,
 so there is no place to put the evidence bindigns)   I suggest you add a DEBUG-only assertion to check this.<u></u><u></u></p><p class="MsoNormal"><u></u> <u></u></p>
<ul style="margin-top:0cm" type="disc">
<li class="m_637828321027685404m_-3607345558727168865MsoListParagraph" style="margin-left:0cm">Do -ddump-tc -fprint-typechecker-elaboration; that should show you the evidence binds.<u></u><u></u></li></ul><p class="MsoNormal"><u></u> <u></u></p><p class="MsoNormal">Can I ask you a favour?  Separately from your branch, can you start a branch of small patches to GHC that include<u></u><u></u></p>
<ul style="margin-top:0cm" type="disc">
<li class="m_637828321027685404m_-3607345558727168865MsoListParagraph" style="margin-left:0cm">Extra assertions, such as that above<u></u><u></u></li><li class="m_637828321027685404m_-3607345558727168865MsoListParagraph" style="margin-left:0cm"><b><span style="font-family:"Courier New"">Notes</span></b> that explain things you wish you’d known earlier, with references to those Notes from the places you were studying when
 you that information would have been useful<u></u><u></u></li></ul><p class="MsoNormal"><u></u> <u></u></p><p class="MsoNormal">Richard and I know too much! – your learning curve is very valuable and I don’t want to lose it.<u></u><u></u></p><p class="MsoNormal"><u></u> <u></u></p><p class="MsoNormal">Keeping this separate from your branch is useful : you can commit (via Phab) these updates right away, so they aren’t predicated on adding row types to GHC.<u></u><u></u></p><p class="MsoNormal"><u></u> <u></u></p><p class="MsoNormal">Simon<u></u><u></u></p><p class="MsoNormal"><span style="font-size:12.0pt"><u></u> <u></u></span></p>
<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">From:</span></b><span lang="EN-US"> ghc-devs [mailto:<a href="mailto:ghc-devs-bounces@haskell.org" target="_blank">ghc-devs-bounces@haskell.org</a>]
<b>On Behalf Of </b>Nicolas Frisby<br>
<b>Sent:</b> 19 September 2017 16:51<br>
<b>To:</b> <a href="mailto:ghc-devs@haskell.org" target="_blank">ghc-devs@haskell.org</a><br>
<b>Subject:</b> Invariants about UnivCo?<u></u><u></u></span></p>
</div>
</div></div></div></div><div lang="EN-GB" link="blue" vlink="purple"><div class="m_637828321027685404m_-3607345558727168865WordSection1"><div style="border:none;border-left:solid blue 1.5pt;padding:0cm 0cm 0cm 4.0pt"><p class="MsoNormal"><u></u> <u></u></p>
<div>
<div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
[I summarize with some direct questions at the bottom of this email.]<u></u><u></u></p>
</div>
<div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<u></u> <u></u></p>
</div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
I spent time last night trying to eliminate -dcore-lint errors from my record and variant library using the coxswain row types plugin. I made some progress, but I'm currently stuck, as discussed on this github Issue.<u></u><u></u></p>
<div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<u></u> <u></u></p>
<div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<a href="https://na01.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgithub.com%2Fnfrisby%2Fcoxswain%2Fissues%2F3%23issuecomment-330577609&data=02%7C01%7Csimonpj%40microsoft.com%7Cde0675bbb584495a2f8008d4ff764c72%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C636414330952932223&sdata=lPLcpIlb%2BhivQdCUoVOPUgYDHeEDaMX660NQS%2BQyyBw%3D&reserved=0" target="_blank">https://github.com/nfrisby/coxswain/issues/3#issuecomment-330577609</a><u></u><u></u></p>
</div>
</div>
<div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<u></u> <u></u></p>
</div>
<div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
Here's the relevant bit:<u></u><u></u></p>
</div>
<div><p class="MsoNormal" style="margin-right:0cm;margin-bottom:6.0pt;margin-left:0cm">
<u></u> <u></u></p>
</div>
<div><p class="MsoNormal"><span style="font-size:10.5pt;font-family:"Segoe UI",sans-serif;color:#24292e">The latest unresolved </span><code><span style="font-size:9.0pt;font-family:Consolas;color:#24292e">-dcore-lint</span></code><span style="font-size:10.5pt;font-family:"Segoe UI",sans-serif;color:#24292e"> error
 is an out-of-scope </span><code><span style="font-size:9.0pt;font-family:Consolas;color:#24292e">cobox</span></code><span style="font-size:10.5pt;font-family:"Segoe UI",sans-serif;color:#24292e"> co var. I'm certainly not creating it <em><span style="font-family:"Segoe UI",sans-serif">directly</span></em> (there
 are no </span><code><span style="font-size:9.0pt;font-family:Consolas;color:#24292e">U(plugin:coxswain,...</span></code><span style="font-size:10.5pt;font-family:"Segoe UI",sans-serif;color:#24292e"> in the Core Lint warning), but I have to wonder if my somewhat
 loose use of </span><code><span style="font-size:9.0pt;font-family:Consolas;color:#24292e">UnivCo</span></code><span style="font-size:10.5pt;font-family:"Segoe UI",sans-serif;color:#24292e"> is violating some assumptions somewhere that's causing GHC to drop
 the co var binding or overlook this occurrence of it on a renaming/subst pass. I checked </span><code><span style="font-size:9.0pt;font-family:Consolas;color:#24292e">UnivCo</span></code><span style="font-size:10.5pt;font-family:"Segoe UI",sans-serif;color:#24292e"> for
 source comments looking for anything it should <em><span style="font-family:"Segoe UI",sans-serif">not</span></em> be used for, but I didn't find an obvious explanation along those lines.</span>  <u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">I haven't yet been able to effectively distill the test case.<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">I'm doing this all at -O0.<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">With `-ddump-tc-trace`, I can see the offending cobox (cobox_a67M) is present in an "implication evbinds" listing after a "solveImplication end }" delimiter, but that's the last obvious binding of it.<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div>
<div><p class="MsoNormal">                         [G] cobox_a67J = CO Sym cobox_a654,<u></u><u></u></p>
</div>
<div><p class="MsoNormal">                         [G] cobox_a67M<u></u><u></u></p>
</div>
<div><p class="MsoNormal">                           = cobox_a67J `cast` U(plugin:coxswain,...)<u></u><u></u></p>
</div>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">cobox_a654 is introduced by a GADT pattern match. <u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">I'm also not seeing obvious occurrences of cobox_a67M, but I think the reason is that I'm seeing several (Sym cobox) with no uniques printed (even with `-dppr-debug`). Those are probably the cobox in question, but I can't confirm.<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">Questions:<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">1) Is there a robust way to ensure that covar's uniques are always printed? (Is the pprIface reuse  with a free cobox part of the issue here?)<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">2) Is my plugin asking for this kind of trouble by using UnivCo to cast coboxes?<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">3) If I spent the effort to create non-UnivCo coercions where possible, would that likely help? This is currently an "eventually" task, but I haven't seen an urgency for it yet. I could bump its priority if it might help. E.G. I'm using
 UnivCo to cast entire givens when all I'm doing is reducing a type family application somewhere "deep" within the given's predtype. I could, with considerable effort, instead wrap a single, localized UnivCo within a bunch of non-UnivCo "lifting" coercion constructors.
 Would that likely help?<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">3) Is there a usual suspect for this kind of situation where a cobox binding is seemingly dropped (by the typechecker) even though there's an occurrence of it?<u></u><u></u></p>
</div>
<div><p class="MsoNormal"><u></u> <u></u></p>
</div>
<div><p class="MsoNormal">Thank you for your time. -Nick<u></u><u></u></p>
</div>
</div>
</div></div></div></blockquote></div></div></blockquote></div></div><div style="word-wrap:break-word"><div><blockquote type="cite"><div>
_______________________________________________</div></blockquote></div></div><div style="word-wrap:break-word"><div><blockquote type="cite"><div><br>ghc-devs mailing list<br><a href="mailto:ghc-devs@haskell.org" target="_blank">ghc-devs@haskell.org</a><br><a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs</a><br></div></blockquote></div></div></blockquote></div>