[GHC] #15321: Typed holes in Template Haskell splices produce bewildering error messages

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template | Version: 8.4.3 Haskell | Keywords: TypedHoles | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- If you compile this program with GHC 8.4 or later: {{{#!hs {-# LANGUAGE TemplateHaskell #-} module Bug where foo :: String foo = test bar :: String bar = $(_ "baz") }}} You'll be greeted with a rather strange error message: {{{ $ /opt/ghc/8.4.3/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:8:7: error: • GHC stage restriction: ‘foo’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally • In the untyped splice: $(_ "baz") | 8 | bar = $(_ "baz") | ^^^^^^^^^^ }}} `foo` has nothing do with how `bar`'s RHS should be typechecked, so why is it being mentioned in the error message? In contrast, GHC 8.2 and earlier gives you quite a nice error message: {{{ $ /opt/ghc/8.2.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:8:9: error: • Found hole: _ :: [Char] -> Language.Haskell.TH.Lib.ExpQ • In the expression: _ In the expression: _ "baz" In the untyped splice: $(_ "baz") | 8 | bar = $(_ "baz") | ^ }}} Tritlo, my hunch is that the valid hole fits stuff is the culprit here. Do you think that perhaps when building the subsumption graph, we are trying to check the hole's type against that of `foo`, which causes the stage restriction error? If so, do you think it is possible to work around this? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * milestone: 8.6.1 => 8.8.1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mgsloan): I'm trying to get more familiar with working on GHC / TH, so took a look at the trac issues. This one seemed interesting to resolve, so I took a look. Just writing a note here so that y'all know there is work in progress here. I think I've figured it out! Indeed, when searching for valid hole fits, it is considering names that come from the current module, even when in a TH splice. My plan is to check `tcl_th_ctxt` to see if we're in a splice, and in that case omit `lcl` (module locals) from the computation of `locals` in `findValidHoleFits`. `lclBinds` will still be used, since locals within the splice certainly should be checked for fitting. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4907 Wiki Page: | -------------------------------------+------------------------------------- Changes (by mgsloan): * differential: => Phab:D4907 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * differential: Phab:D4907 => Comment: You're right. In `TcHoleErrors` we see {{{ lookup :: Either Id GlobalRdrElt -> TcM (Maybe Id) lookup (Left id) = return $ Just id lookup (Right el) = do { thing <- tcLookup (gre_name el) ; case thing of }}} That call to `tcLookup` checks for staging errors (it calls `tcLookupGlobal` which calls `notFound`). Easiest solution: something like {{{ lookup (Right el) = tryTcDiscardingErrs (return Nothing) $ do { thing <- tcLookup (gre_name el) ; case thing of }}} The `tryTcDiscardingErrs` does what it sounds like. It's not super-efficient, but it doesn't have to be ... this is in error- message generation only. It needs a `Note` to explain why the lookup can fail. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): PS I missed your patch. I think the approach in comment:4 would be more comprehensible -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mgsloan): Ah, that makes sense Simon, thanks for the input! I have a concern with using `tryTcDiscardingErrors` here - it could hide problems. Errant omission of output is hard to notice in a mechanism like hole fitting - you would need to somehow notice a pattern of omission. Limiting the number of results also contributes to this. Based on this reasoning, here's what I'm thinking should be done: * First, the implementation you suggest. I'm not sure where things are in the release process, but having holes be so broken in GHCi isn't so good (https://ghc.haskell.org/trac/ghc/ticket/15202), and a change related to your suggestion would fix it. * In a subsequent change, using `tryTc` and recording the errors that are encountered, while still getting results for hole fitting. Then, including one of the exceptions as a "Please report this as a GHC bug" type of message. This way, we get hole fitting results, but errors like this get noticed and resolved. Breaking it up into these 2 steps is mainly motivated by the potential for the first portion to be included in the release. Coincidentally, before I read your comment I implemented a change that catches errors for the entire hole fitting process, rather than just portions - https://phabricator.haskell.org/D4908 . I'm favoring abandoning that approach and doing this more fine-grained catching. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Tritlo): Oh my, this is bad, especially #15007. I wish that I'd known earlier! I think that the approach mentioned in comment:4 is the way to go for now, as the "include" in "Valid hole fits include" allow us to err on the side of omission, and I hope that we can add this ASAP. I'll then make sure to implement more comprehensive fix, as mentioned in comment:6 later. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Tritlo): I've pushed an intermittent fix in https://phabricator.haskell.org/D4909. It is a bit more comprehensive (discarding ANY candidate that causes an error, not just errors in `tcLookup`), but uses the same approach as suggested in comment:4. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mgsloan): I've considered this further, and I'm thinking my concerns about masking errors may be unfounded. Problems typechecking candidates are likely to be discovered other ways. On the other hand, this might be an interesting way to have users fuzz testing the typechecker ;) Your change looks good to me. I think something like https://phabricator.haskell.org/D4907 may still make sense, but I'll leave it up to y'all. It is certainly an efficiency / complexity tradeoff. One benefit beyond efficiency is that `-ddump-tc- trace` might be slightly more comprehensible if it isn't evaluating holes that the typechecker errors on. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Tritlo): I agree, it would both be faster and produce better output in the tc trace, but just discarding candidates that cause errors is the right thing to do, since those aren't valid hole fits anyway (since they cause an error). I think that further work to optimize and improve is in order, but I hope that the current patch is small enough to make it into 8.6 without issue, and leave the more thoughtful overhaul for later. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.8.1 => 8.6.1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4909 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D4909 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner: (none)
Type: bug | Status: patch
Priority: normal | Milestone: 8.6.1
Component: Template Haskell | Version: 8.4.3
Resolution: | Keywords: TypedHoles
Operating System: Unknown/Multiple | Architecture:
Type of failure: Poor/confusing | Unknown/Multiple
error message | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s): Phab:D4909
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Ömer Sinan Ağacan

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4909 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => merge -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:14 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4909 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks -- can we add a regression test? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#15321: Typed holes in Template Haskell splices produce bewildering error messages
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner: (none)
Type: bug | Status: merge
Priority: normal | Milestone: 8.6.1
Component: Template Haskell | Version: 8.4.3
Resolution: | Keywords: TypedHoles
Operating System: Unknown/Multiple | Architecture:
Type of failure: Poor/confusing | Unknown/Multiple
error message | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s): Phab:D4909
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Ömer Sinan Ağacan

#15321: Typed holes in Template Haskell splices produce bewildering error messages -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: fixed | Keywords: TypedHoles Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4909 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: comment:13 merged with 22c951e6aab52adf32499a9568be44dc60e72acb. comment:16 merged with 132273f34e394bf7e900d0c15e01e91edd711890. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15321#comment:17 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC