[GHC] #10506: SourceNotes are not applied to all identifiers

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Blocked By: Test Case: | Related Tickets: Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Compiling {{{ module Foo where foo x = x + 1 bar y = foo y }}} with `-g` produces {{{ $ ghc -g -ddump-ticked test.hs [1 of 1] Compiling Foo ( test.hs, test.o ) AbsBinds [a_avC] [$dNum_avD] {Exports: [foo <= foo_amB <>] Exported types: foo :: forall a_avC. Num a_avC => a_avC -> a_avC [LclId, Str=DmdType] Binds: -- ticks = [srctest.hs:3:1-13] foo_amB x_alA = srctest.hs:3:9-13 (+) srctest.hs:3:9 x_alA srctest.hs:3:13 1} AbsBinds [a_avV] [$dNum_avW] {Exports: [bar <= bar_avN <>] Exported types: bar :: forall a_avV. Num a_avV => a_avV -> a_avV [LclId, Str=DmdType] Binds: -- ticks = [srctest.hs:5:1-13] bar_avN y_amz = srctest.hs:5:9-13 foo (srctest.hs:5:13 y_amz)} }}} Note that neither the occurrence of `(+)` in `foo`, nor the occurrence of `foo` in `bar` have their own Ticks. Instead they are only covered by the Tick for the entire application `x + 1` (resp. `foo y`). I'm trying to use the new SourceNote infrastructure to map CoreExprs back to their original source location, but unfortunately I need these locations for each identifier in the source. Would it be reasonable to add a SourceNote to each occurrence of an identifier? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: None/Unknown | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by simonpj): This is to do with the HPC program coverage stuff (Andy Gill), right? Or is it DWARF stuff (Peter Wortman)? Embarrassingly I cannot see documentation in the manual for `-g` or `-ddump-ticked`; so that should be fixed too. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: None/Unknown | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by gridaphobe): `-g` is the DWARF stuff, but judging by the Coverage module, the DWARF and HPC flags use the same strategy for ticking expressions (`TickForCoverage`). -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: None/Unknown | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Changes (by thomie): * cc: scpmw (added) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: None/Unknown | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by scpmw): I didn't actually change how `TickForCoverage` behaves, so these design decisions actually go back to HPC. Changing it would be quite easy - probably just replacing a few `addTickLHsExprNever` in `addTickHsExpr` by `addTickLHsExpr`. On the other hand I'm not quite sure we want that. The original reason was probably that it leads to rather silly stacks of ticks on functions that are applied to many arguments. Plus both source notes and HPC ticks would instantly float upwards, which means that we are not actually gaining any information. Source notes get merged eventually, but for HPC it certainly would make a performance difference. Do you positively need every single expression annotated? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: None/Unknown | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by gridaphobe): I don't think we need every expression annotated, but we do need every '''identifier''' annotated. This is in the context of LiquidHaskell, where we infer refinement types for Haskell functions. One output mode we have (which is invaluable in my experience) is an HTML version of the Haskell module where each identifier is annotated with a popup containing its refined type. To create this annotated HTML document, we do need precise source locations for each occurrence of an identifier (and lambda expressions). I doubt the performance overhead would be that bad if we restrict the extra ticks to identifiers and lambdas, but if it turns out to be a problem I'd also be perfectly happy with a separate `TickEverything` strategy that we can select. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: None/Unknown | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by simonpj): This tick stuff is clearly interesting and useful, but it is serving several masters, which are expressed by `CoreSyn.Tickish`: * `HpcTick`: HPC code coverage * `ProfNote`: cost-centre profiling * `Breakpoint`: breakpoint debugging * `SourceNote`: do not get in the way of optimisation, but help with debugging via DWARF. They differ in the extent to which they interfere with optimisation. You probably want either `SourceNote` or `HpcTick` here; but I'm not sure which. It depends on the semantics you expect during optimisation. I suspect you want `SourceNote`. I hope you don't need a fifth one! Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.2 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: None/Unknown | Unknown/Multiple Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by scpmw): If I understand correctly, this is primarily about inferring type information about the original program from a (ticked) Haskell syntax dump. So it doesn't matter what later stages of GHC do with the ticks, as long as they appear in that particular dump. And it's quite tempting to do, because we are 99% there and the change would be rather trivial. Main "problem" is that there's simply no good reason in the context of the compiler to behave like this. If we change the default behaviour, it would certainly need a guarding comment that says why this special case exists. I think I'll make some kind of patch this week, not quite sure what it will look like though. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.3 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by bgamari): scpmw, any updates here? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.3 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Changes (by scpmw): * Attachment "tick-vars.patch" added. Proposed patch -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.3 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by scpmw): Patch attached, but not too happy with it. Making it a dump patch is probably the least offensive option - at least it shows the right intent. Yet it is awkward both in terms of overriding the "tick never" as well as in terms of actually changing the Haskell syntax tree based on a dump flag. Does this at least help you, gridaphobe? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.3 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by gridaphobe): Thanks scpmw, this looks promising. I'll build LiquidHaskell against your patch and make sure we get the extra Ticks we need. For our purposes, hiding this behind a flag is fine, but calling it a dump flag seems a bit off to me. As your comment says, the flag is modifying the generated Core, wouldn't a name like `-ftick-everything` make more sense? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.3 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Comment (by gridaphobe): Hrm, this patch doesn't produce the output I would expect. Consider {{{ module Bar where bar = 1 + 2 }}} {{{ $ ghc -ddump-tick-vars -ddump-ticked -g bar.hs [1 of 1] Compiling Bar ( bar.hs, bar.o ) AbsBinds [] [] {Exports: [bar <= bar_amB <>] Exported types: bar :: Integer [LclId, Str=DmdType] Binds: -- ticks = [srcbar.hs:3:1-11] bar_amB = srcbar.hs:3:7-11 (+) srcbar.hs:3:7 1 srcbar.hs:3:11 2} }}} The tick on the `(+)` spans the whole application, which is not precise enough for us. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 7.10.3 => 8.0.1 Comment: This won't be fixed for 7.10.3 as there is no fix yet. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:13 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by scpmw): Right. Is this still current? If I remember correctly I tried to track down why my patch doesn't do the right thing here, but got lost somewhere. This is a really easy change, we should resolve it one way or the other. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:14 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by gridaphobe): GHC HEAD as of bbad4f6b5894c3deb417a056e0fd3fd75da7f593 (the latest commit I have built locally) still only produces a tick for the entire application expression (missing the `(+)` occurrence), so I suspect it's still an issue. It would be really nice to fix this in time for 8.0. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by gridaphobe): * Attachment "tick-everything.patch" added. A variant of scpmw's patch -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by gridaphobe): I've added a slight variant of scpmw's patch that adds ticks everywhere with a new `-ftick-everything` flag. It seems that the HsVar pattern was too restrictive. I'm not sure why.. But I don't see any harm in being more generous with Ticks given that this will be hidden behind a flag. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:16 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: patch Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1565 Wiki Page: | -------------------------------------+------------------------------------- Changes (by gridaphobe): * status: new => patch * differential: => Phab:D1565 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:17 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1565 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => new Comment: The diff is blocked on changes so I'm going punt this out of patch state. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:18 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: patch Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1565 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch Comment: gridaphobe, it seems I must have overlooked your patch when I left comment:17. Would it still be helpful to merge it? It seems like a fairly unintrusive change. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:20 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: patch Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1565 Wiki Page: | -------------------------------------+------------------------------------- Comment (by gridaphobe): It turns out the patch I attached doesn't actually work for my purposes (I think I had only tested it with `-ddump-ticked` instead of building LiquidHaskell against it). There's a brief discussion of why on Phab (https://phabricator.haskell.org/D1565#inline-13012). I can work around this by moving `simpleOptPgm` to a first Core2Core pass, thus exposing the fully unoptimized Core to API users and Plugins. But that's a much more invasive change, and could break existing API users and Plugins. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:21 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1565 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => new * milestone: 8.2.1 => 8.4.1 Comment: Alright, then I'm going to bump this off to 8.4 since the hour is late and there is no obvious solution in sight. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:22 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10506: SourceNotes are not applied to all identifiers -------------------------------------+------------------------------------- Reporter: gridaphobe | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1565 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => infoneeded * milestone: 8.6.1 => Comment: gridaphobe, what ended up happening with this? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10506#comment:24 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC