[GHC] #11245: Non-exhaustive pattern, "Patterns not matched" list is empty

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Example: {{{#!haskell module Main where maybeOdd :: Int -> Maybe Int maybeOdd i = if odd i then Just i else Nothing main :: IO () main = do let x = maybeOdd 10 let a | Just i <- x , odd i = True | Nothing <- x = False print x print a }}} Warning printed by GHC HEAD: {{{ Exhaustive.hs:10:7: warning: Pattern match(es) are non-exhaustive In an equation for ‘a’: Patterns not matched: Linking Exhaustive ... }}} The problem with this message is; if it couldn't come up with an example unmatched pattern, then how can it know that the pattern is non- exhaustive? If it came up with an example, why is that example not printed? UPDATE: I just realized it's actually worse that I first thought. If I change {{{a}}} in this example: {{{#!haskell let a | Just i <- x = True }}} This message is printed: {{{ [1 of 1] Compiling Main ( Exhaustive.hs, Exhaustive.o ) Exhaustive.hs:10:7: warning: Pattern match(es) are non-exhaustive In an equation for ‘a’: Patterns not matched: Exhaustive.hs:10:16: warning: Defined but not used: ‘i’ Linking Exhaustive ... }}} NOTE: Tried with GHC 7.10 too. It seems like in the case where the checks are not exhaustive, both 7.10 and HEAD are giving the same warning(with empty list of non-checked patterns). HEAD is better in detecting exhaustive patterns. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 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 simonpj): * owner: => gkaracha -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 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 gkaracha): Yes, this will probably not be fixed. It is not exactly a bug: Since `a` is a nullary function, there is nothing to print. The only possible thing to print would be something like: {{{#!hs Exhaustive.hs:10:7: warning: Pattern match(es) are non-exhaustive In an equation for `a': Patterns not matched: ??? where (x ~ Just i) && (not (odd i)) }}} but there is nothing to actually print as a pattern because you have zero arguments. Additionally, you wrote **"UPDATE: I just realized it's actually worse that I first thought. If I change a in this example: {...} This message is printed: {...}"** but the following gives no warning on my computer: {{{#!hs let a | Just i <- x = True | Nothing <- x = False }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 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 goldfire): I see your point about this not being a bug, but can't we have a better error message? For example: {{{ Exhaustive.hs:10:7: warning: Pattern match(es) are non-exhaustive In the definition for ‘a’: Cases not matched: (Just i <- x), not (odd i) }}} Maybe it's hard to get that "cases not matched" so exactly, but at least we can say vaguely that the guards are incomplete, instead of the error suggesting that a list follows but then omitting the list. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 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 gkaracha): Ah, yes, this is easy to do I guess. We can always check every uncovered vector before printing for being `[]`. If yes, we can print something like: {{{ Exhaustive.hs:10:7: warning: Pattern match(es) are non-exhaustive In the definition for ‘a’: Cases not matched: (incomplete guards) }}} I am gonna patch this too :) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 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 osa1): I don't understand the argument about the definition not having any arguments. The exhaustiveness checker somehow checking for some patterns, right? And on the process it has to realize that some patterns are not checked. Whatever that it's finding on the process, it should print! Am I missing anything? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 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 gkaracha): Replying to [comment:5 osa1]:
I don't understand the argument about the definition not having any arguments. The exhaustiveness checker somehow checking for some patterns, right? And on the process it has to realize that some patterns are not checked. Whatever that it's finding on the process, it should print! Am I missing anything?
Yes, this is true! But there are at least two good reasons at the moment for not printing this information: * This information may be too much for the eye (think of a big definition with a well-populated `where`-clause, like the ones you often find in GHC itself). Don't forget that the bag contains **all** constraints that are in scope, independently of being relevant to the specific match or not. * The pattern match checker does some simplifications in order to have reasonable performance and memory requirements. As you can see, there are already many problems concerning the checker's performance: #11195, #11239, #11276, ... so I would not push it more at the moment. The simplifications I am talking about are important not only for performance but also for the consistency of the final result and its usefulness to the user. At the moment the checker does not substitute in `HsExpr`. Instead, I have lifted `HsExpr` to `PmExpr`: {{{#!hs data PmExpr = PmExprVar Id | PmExprCon DataCon [PmExpr] | PmExprLit PmLit | PmExprEq PmExpr PmExpr -- Syntactic equality | PmExprOther (HsExpr Id) -- Note [PmExprOther in PmExpr] }}} Term substitution at the moment does not affect `PmExprOther` (see function `substPmExpr` in `deSugar/PmExpr.hs`) because substituting in `HsSyn` would be massive and at the moment would affect only the appearance but not the expressive power of the check. Hence, the final result may look inconsistent (it is not, because we do not actually inspect `HsExpr` at all so substituting or not at the moment makes no difference). I would like to give something more detailed to the user too but for the moment I think it is not a priority so, for now, I'd go with what I showed above, until I have a nice solution to these problems. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty
-------------------------------------+-------------------------------------
Reporter: osa1 | Owner: gkaracha
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.11
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 Ben Gamari

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 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 gkaracha): Henceforth, a non-exhaustiveness warning about a match for which guards are responsible (the match has no arguments so incompleteness appears due to guards not covering all possible cases), a better warning will be printed. E.g. for the example above, the warning issued will be: {{{ T11245.hs:12:7: warning: Pattern match(es) are non-exhaustive In an equation for ‘a’: Guards do not cover entire pattern space }}} There is probably (probably because it is always subject to the performance cost) room for improvement, like printing more details concerning failure, but I think I can safely close this ticket now. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: fixed | 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 gkaracha): * status: new => closed * resolution: => fixed -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: closed Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: fixed | 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: => 8.0.1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty
-------------------------------------+-------------------------------------
Reporter: osa1 | Owner: gkaracha
Type: bug | Status: closed
Priority: normal | Milestone: 8.0.1
Component: Compiler | Version: 7.11
Resolution: fixed | 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 Simon Peyton Jones

#11245: Non-exhaustive pattern, "Patterns not matched" list is empty -------------------------------------+------------------------------------- Reporter: osa1 | Owner: gkaracha Type: bug | Status: closed Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | pmcheck/should_compile/T11245 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => pmcheck/should_compile/T11245 Comment: Good. But always add a regression test and fill in the "Test case" field of the ticket. I've done this for you. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11245#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC