Why TcLclEnv and DsGblEnv need to store the same IORef for errors?

Alfredo Di Napoli alfredo.dinapoli at gmail.com
Thu Apr 1 06:00:59 UTC 2021


Hello all,

John: right, I am not opposed to what you describe, but at the end of the
day we need to add all these messages to a single IORef (unless we go with
the two IORef idea that Richard is not fond of), and for that we need a
single monomorphic type, which could be, initially, even something like:

type TcRnDsMessage = Either DsMessage TcRnMessage

I guess I'll have to iterate on this until we get something meaningful and
that passes the full testsuite :)

A.



On Wed, 31 Mar 2021 at 16:36, John Ericson <john.ericson at obsidian.systems>
wrote:

> I might still be tempted to do:
> data DsMessage =
>     ...
>   | DsLiftedTcRnMessage !TcRnMessage
>   -- ^ A diagnostic coming straight from the Typecheck-renamer.
>
> data TcRnMessage =
>     ...
>   | TcRnLiftedDsMessage !DsMessage
>   -- ^ A diagnostic coming straight from the Desugarer.
>
> tying them together with hs-boot. Yes, that means one can do some silly
> `TcRnLiftedDsMessage . DsLiftedTcRnMessage . TcRnLiftedDsMessage ...`, but
> that could even show up in a render as "while desugaring a splice during
> type checking, while typechecking during desguaring, ..." so arguably the
> information the wrapping isn't purely superfluous.
>
> I think this would pose no practical problem today, while still "soft
> enforcing" the abstraction boundaries we want.
>
> On 3/31/21 3:45 AM, Alfredo Di Napoli wrote:
>
> Follow up:
>
> Argh! I have just seen that I have a bunch of test failures related to my
> MR (which, needless to say, it's still WIP).
>
> For example:
>
> run/T9140.run.stdout.normalised 2021-03-31 09:35:48.000000000 +0200
> @@ -1,12 +1,4 @@
>
> -<interactive>:2:5:
> -    You can't mix polymorphic and unlifted bindings: a = (# 1 #)
> -    Probable fix: add a type signature
> -
> -<interactive>:3:5:
> -    You can't mix polymorphic and unlifted bindings: a = (# 1, 3 #)
> -    Probable fix: add a type signature
> -
>
> So it looks like some diagnostic is now not being reported and, surprise
> surprise, this was emitted from the DsM monad.
>
> I have the suspect that indeed Richard was right (like he always is :) )
> -- when we go from a DsM to a TcM monad (See `initDsTc`) for example, I
> think we also need to carry into the new monad all the diagnostics we
> collected so far.
>
> This implies indeed a mutual dependency (as Simon pointed out, heh).
>
>
> So I think my cunning plan of embedding is crumbling -- I suspect we would
> end up with a type `TcRnDsMessage` which captures the dependency.
>
> Sorry for not seeing it sooner!
>
>
>
>
>
>
>
>
> On Wed, 31 Mar 2021 at 08:05, Alfredo Di Napoli <
> alfredo.dinapoli at gmail.com> wrote:
>
>> Morning all,
>>
>> *Richard*: sorry! Unfortunately MR !4798 is the cornerstone of this
>> refactoring work but it's also gargantuan. Let's discuss a plan to attack
>> it, but fundamentally there is a critical mass of changes that needs to
>> happen atomically or it wouldn't make much sense, and alas this doesn't
>> play in our favour when it comes to MR size and ease of review. However, to
>> quickly reply to your remak: currently (for the sake of the
>> "minimum-viable-product") I am trying to stabilise the external interfaces,
>> by which I mean giving functions their final type signature while I do
>> what's easiest to make things typecheck. In this phase what I think is the
>> easiest is to wrap the majority of diagnostics into the `xxUnknownxx`
>> constructor, and change them gradually later. A fair warning, though: you
>> say "I would think that a DsMessage would later be wrapped in an
>> envelope." This might be true for Ds messages (didn't actually invest any
>> brain cycles to check that) but in general we have to turn a message into
>> an envelope as soon as we have a chance to do so, because we need to grab
>> the `SrcSpan` and the `DynFlags` *at the point of creation* of the
>> diagnostics. Carrying around a message and make it bubble up at some random
>> point won't be a good plan (even for Ds messages). Having said that, I
>> clearly have very little knowledge about this area of GHC, so feel free to
>> disagree :)
>>
>> *John*: Although it's a bit hard to predict how well this is going to
>> evolve, my current embedding, to refresh everyone's memory, is the
>> following:
>>
>> data DsMessage =
>>
>>     DsUnknownMessage !DiagnosticMessage
>>
>>   -- ^ Stop-gap constructor to ease the migration.
>>
>>   | DsLiftedTcRnMessage !TcRnMessage
>>
>>   -- ^ A diagnostic coming straight from the Typecheck-renamer.
>>
>>   -- More messages added in the future, of course
>>
>>
>> At first I thought this was the wrong way around, due to Simon's comment,
>> but this actually creates pleasant external interfaces. To give you a bunch
>> of examples from MR !4798:
>>
>>
>> deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages DsMessage,
>> Maybe ModGuts)
>> deSugarExpr :: HscEnv -> LHsExpr GhcTc -> IO (Messages DsMessage, Maybe
>> CoreExpr)
>>
>> Note something interesting: the second function actually calls
>> `runTcInteractive` inside the body, but thanks to the `DsLiftedTcRnMessage`
>> we can still expose to the consumer an opaque `DsMessage` , which is what I
>> would expect to see from a function called "deSugarExpr". Conversely, I
>> would be puzzled to find those functions returning a `TcRnDsMessage`.
>>
>>
>> Having said all of that, I am not advocating this design is "the best". I
>> am sure we will iterate on it. I am just reporting that even this baseline
>> seems to be decent from an API perspective :)
>>
>>
>> On Wed, 31 Mar 2021 at 05:45, John Ericson
>> <john.ericson at obsidian.systems> <john.ericson at obsidian.systems> wrote:
>>
>>> Alfredo also replied to this pointing his embedding plan. I also prefer
>>> that, because I really wish TH didn't smear together the phases so much.
>>> Moreover, I hope with
>>>
>>>  - GHC proposals https://github.com/ghc-proposals/ghc-proposals/pull/412
>>> / https://github.com/ghc-proposals/ghc-proposals/pull/243
>>>
>>>  - The parallelism work currently be planned in
>>> https://gitlab.haskell.org/ghc/ghc/-/wikis/Plan-for-increased-parallelism-and-more-detailed-intermediate-output
>>>
>>> we might actually have an opportunity/extra motivation to do that.
>>> Splices and quotes will still induce intricate inter-phase dependencies,
>>> but I hope that could be mediated by the driver rather than just baked into
>>> each phase.
>>>
>>> (One final step would be the "stuck macros" technique of
>>> https://www.youtube.com/watch?v=nUvKoG_V_U0 /
>>> https://github.com/gelisam/klister, where TH splices would be able to
>>> making "blocking queries" of the the compiler in ways that induce more of
>>> these fine-grained dependencies.)
>>>
>>> Anyways, while we could also do a "RnTsDsError" and split later, I hope
>>> Alfredo's alternative of embedding won't be too much harder and prepare us
>>> for these exciting areas of exploration.
>>>
>>> John
>>> On 3/30/21 10:14 AM, Richard Eisenberg wrote:
>>>
>>>
>>>
>>> On Mar 30, 2021, at 4:57 AM, Alfredo Di Napoli <
>>> alfredo.dinapoli at gmail.com> wrote:
>>>
>>> I'll explore the idea of adding a second IORef.
>>>
>>>
>>> Renaming/type-checking is already mutually recursive. (The renamer must
>>> call the type-checker in order to rename -- that is, evaluate -- untyped
>>> splices. I actually can't recall why the type-checker needs to call the
>>> renamer.) So we will have a TcRnError. Now we see that the desugarer ends
>>> up mixed in, too. We could proceed how Alfredo suggests, by adding a second
>>> IORef. Or we could just make TcRnDsError (maybe renaming that).
>>>
>>> What's the disadvantage? Clients will have to potentially know about all
>>> the different error forms with either approach (that is, using my combined
>>> type or using multiple IORefs). The big advantage to separating is maybe
>>> module dependencies? But my guess is that the dependencies won't be an
>>> issue here, due to the fact that these components are already leaning on
>>> each other. Maybe the advantage is just in having smaller types? Maybe.
>>>
>>> I don't have a great sense as to what to do here, but I would want a
>>> clear reason that e.g. the TcRn monad would have two IORefs, while other
>>> monads will work with GhcMessage (instead of a whole bunch of IORefs).
>>>
>>> Richard
>>>
>>> _______________________________________________
>>> ghc-devs mailing listghc-devs at haskell.orghttp://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>>>
>>> _______________________________________________
>>> ghc-devs mailing list
>>> ghc-devs at haskell.org
>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>>>
>>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20210401/512408fe/attachment.html>


More information about the ghc-devs mailing list