PmCheck: Look at precendence to give type signatures to some wildcards
authorSebastian Graf <sgraf1337@gmail.com>
Wed, 25 Sep 2019 16:16:53 +0000 (16:16 +0000)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Sat, 28 Sep 2019 02:14:44 +0000 (22:14 -0400)
Basically do what we currently only do for -XEmptyCase in other cases
where adding the type signature won't distract from pattern
matches in other positions.

We use the precedence to guide us, equating "need to parenthesise" with
"too much noise".

18 files changed:
compiler/deSugar/PmPpr.hs
testsuite/tests/deSugar/should_compile/T14135.stderr
testsuite/tests/dependent/should_compile/KindEqualities.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase001.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase002.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase004.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase005.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase006.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase007.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase008.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase009.stderr
testsuite/tests/pmcheck/should_compile/EmptyCase010.stderr
testsuite/tests/pmcheck/should_compile/T11336b.stderr
testsuite/tests/pmcheck/should_compile/T11822.stderr
testsuite/tests/pmcheck/should_compile/T15305.stderr
testsuite/tests/pmcheck/should_compile/pmc009.stderr
testsuite/tests/warnings/should_fail/WerrorFail.stderr
testsuite/tests/warnings/should_fail/WerrorFail2.stderr

index 82e6d0f..5b49b2d 100644 (file)
@@ -10,6 +10,7 @@ module PmPpr (
 
 import GhcPrelude
 
+import BasicTypes
 import Id
 import VarEnv
 import UniqDFM
@@ -44,7 +45,12 @@ pprUncovered delta vas
   | otherwise         = hang (fsep vec) 4 $
                           text "where" <+> vcat (map (pprRefutableShapes . snd) (udfmToList refuts))
   where
-    ppr_action       = mapM (pprPmVar 2) vas
+    init_prec
+      -- No outer parentheses when it's a unary pattern by assuming lowest
+      -- precedence
+      | [_] <- vas   = topPrec
+      | otherwise    = appPrec
+    ppr_action       = mapM (pprPmVar init_prec) vas
     (vec, renamings) = runPmPpr delta ppr_action
     refuts           = prettifyRefuts delta renamings
 
@@ -127,44 +133,57 @@ checkRefuts x = do
 
 -- | Pretty print a variable, but remember to prettify the names of the variables
 -- that refer to neg-literals. The ones that cannot be shown are printed as
--- underscores.
-pprPmVar :: Int -> Id -> PmPprM SDoc
+-- underscores. Even with a type signature, if it's not too noisy.
+pprPmVar :: PprPrec -> Id -> PmPprM SDoc
+-- Type signature is "too noisy" by my definition if it needs to parenthesize.
+-- I like           "not matched: _ :: Proxy (DIdEnv SDoc)",
+-- but I don't like "not matched: (_ :: stuff) (_:_) (_ :: Proxy (DIdEnv SDoc))"
+-- The useful information in the latter case is the constructor that we missed,
+-- not the types of the wildcards in the places that aren't matched as a result.
 pprPmVar prec x = do
   delta <- ask
   case lookupSolution delta x of
     Just (alt, args) -> pprPmAltCon prec alt args
-    Nothing          -> fromMaybe underscore <$> checkRefuts x
-
-pprPmAltCon :: Int -> PmAltCon -> [Id] -> PmPprM SDoc
+    Nothing          -> fromMaybe typed_wildcard <$> checkRefuts x
+      where
+        -- if we have no info about the parameter and would just print a
+        -- wildcard, also show its type.
+        typed_wildcard
+          | prec <= sigPrec
+          = underscore <+> text "::" <+> ppr (idType x)
+          | otherwise
+          = underscore
+
+pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc
 pprPmAltCon _prec (PmAltLit l)      _    = pure (ppr l)
 pprPmAltCon prec  (PmAltConLike cl) args = do
   delta <- ask
   pprConLike delta prec cl args
 
-pprConLike :: Delta -> Int -> ConLike -> [Id] -> PmPprM SDoc
+pprConLike :: Delta -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc
 pprConLike delta _prec cl args
   | Just pm_expr_list <- pmExprAsList delta (PmAltConLike cl) args
   = case pm_expr_list of
       NilTerminated list ->
-        brackets . fsep . punctuate comma <$> mapM (pprPmVar 0) list
+        brackets . fsep . punctuate comma <$> mapM (pprPmVar appPrec) list
       WcVarTerminated pref x ->
-        parens   . fcat . punctuate colon <$> mapM (pprPmVar 0) (toList pref ++ [x])
+        parens   . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x])
 pprConLike _delta _prec (RealDataCon con) args
   | isUnboxedTupleCon con
   , let hash_parens doc = text "(#" <+> doc <+> text "#)"
-  = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar 0) args
+  = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args
   | isTupleDataCon con
-  = parens . fsep . punctuate comma <$> mapM (pprPmVar 0) args
+  = parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args
 pprConLike _delta prec cl args
   | conLikeIsInfix cl = case args of
-      [x, y] -> do x' <- pprPmVar 1 x
-                   y' <- pprPmVar 1 y
-                   return (cparen (prec > 0) (x' <+> ppr cl <+> y'))
+      [x, y] -> do x' <- pprPmVar funPrec x
+                   y' <- pprPmVar funPrec y
+                   return (cparen (prec > opPrec) (x' <+> ppr cl <+> y'))
       -- can it be infix but have more than two arguments?
       list   -> pprPanic "pprConLike:" (ppr list)
   | null args = return (ppr cl)
-  | otherwise = do args' <- mapM (pprPmVar 2) args
-                   return (cparen (prec > 1) (fsep (ppr cl : args')))
+  | otherwise = do args' <- mapM (pprPmVar appPrec) args
+                   return (cparen (prec > funPrec) (fsep (ppr cl : args')))
 
 -- | The result of 'pmExprAsList'.
 data PmExprList
index 23a3e90..ec0a340 100644 (file)
@@ -1,4 +1,4 @@
 
 T14135.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In an equation for ‘f’: Patterns not matched: (Foo2 _)
+    In an equation for ‘f’: Patterns not matched: Foo2 _
index 684c138..81bbc53 100644 (file)
@@ -3,4 +3,4 @@ KindEqualities.hs:25:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In an equation for ‘zero’:
         Patterns not matched:
-            (TyApp (TyApp p _) _) where p is not one of {TyInt}
+            TyApp (TyApp p _) _ where p is not one of {TyInt}
index ba9e61f..c3c294b 100644 (file)
@@ -1,3 +1,4 @@
+
 EmptyCase001.hs:9:6: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative: Patterns not matched: _ :: Int
index cbb79ef..d6c39ec 100644 (file)
@@ -1,23 +1,22 @@
 
 EmptyCase002.hs:16:6: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (MkT _)
+    In a case alternative: Patterns not matched: MkT _
 
 EmptyCase002.hs:43:6: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (MkT1 B1)
-            (MkT1 B2)
+            MkT1 B1
+            MkT1 B2
 
 EmptyCase002.hs:47:6: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (MkT1 False)
-            (MkT1 True)
+            MkT1 False
+            MkT1 True
 
 EmptyCase002.hs:51:6: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative:
-        Patterns not matched: (MkT1 (MkT2 (MkT1 D2)))
+    In a case alternative: Patterns not matched: MkT1 (MkT2 (MkT1 D2))
index ba36499..d807b51 100644 (file)
@@ -12,13 +12,13 @@ EmptyCase004.hs:19:6: warning: [-Wincomplete-patterns (in -Wextra)]
 
 EmptyCase004.hs:31:8: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (B1 _)
+    In a case alternative: Patterns not matched: B1 _
 
 EmptyCase004.hs:35:6: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (B1 _)
+            B1 _
             B2
 
 EmptyCase004.hs:47:6: warning: [-Wincomplete-patterns (in -Wextra)]
@@ -34,4 +34,4 @@ EmptyCase004.hs:50:9: warning: [-Wincomplete-patterns (in -Wextra)]
 
 EmptyCase004.hs:51:9: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (B1 _)
+    In a case alternative: Patterns not matched: B1 _
index 8cedcdd..1d185cc 100644 (file)
@@ -1,7 +1,7 @@
 
 EmptyCase005.hs:24:8: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Void3 _)
+    In a case alternative: Patterns not matched: Void3 _
 
 EmptyCase005.hs:67:8: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
@@ -14,19 +14,19 @@ EmptyCase005.hs:73:8: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (MkTBool False)
-            (MkTBool True)
+            MkTBool False
+            MkTBool True
 
 EmptyCase005.hs:79:8: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (MkTInt _)
+    In a case alternative: Patterns not matched: MkTInt _
 
 EmptyCase005.hs:91:8: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (MkV False)
-            (MkV True)
+            MkV False
+            MkV True
 
 EmptyCase005.hs:101:8: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
index f63a438..e47e1ee 100644 (file)
@@ -1,12 +1,12 @@
 
 EmptyCase006.hs:18:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Foo1 MkGA1)
+    In a case alternative: Patterns not matched: Foo1 MkGA1
 
 EmptyCase006.hs:26:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (Foo1 MkGA1)
-            (Foo1 (MkGA2 _))
-            (Foo1 MkGA3)
+            Foo1 MkGA1
+            Foo1 (MkGA2 _)
+            Foo1 MkGA3
index f0c36b9..42cbcf3 100644 (file)
@@ -9,11 +9,11 @@ EmptyCase007.hs:25:7: warning: [-Wincomplete-patterns (in -Wextra)]
 
 EmptyCase007.hs:33:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Foo2 (_, _))
+    In a case alternative: Patterns not matched: Foo2 (_, _)
 
 EmptyCase007.hs:37:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Foo2 _)
+    In a case alternative: Patterns not matched: Foo2 _
 
 EmptyCase007.hs:44:17: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
@@ -23,5 +23,5 @@ EmptyCase007.hs:48:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (Foo2 [])
-            (Foo2 (_:_))
+            Foo2 []
+            Foo2 (_:_)
index 9999193..b33e8eb 100644 (file)
@@ -3,8 +3,8 @@ EmptyCase008.hs:17:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (Foo3 (MkDA1 _))
-            (Foo3 MkDA2)
+            Foo3 (MkDA1 _)
+            Foo3 MkDA2
 
 EmptyCase008.hs:21:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
@@ -12,7 +12,7 @@ EmptyCase008.hs:21:7: warning: [-Wincomplete-patterns (in -Wextra)]
 
 EmptyCase008.hs:40:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Foo4 MkDB1)
+    In a case alternative: Patterns not matched: Foo4 MkDB1
 
 EmptyCase008.hs:48:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
index 7d2e84c..e5ea398 100644 (file)
@@ -5,8 +5,8 @@ EmptyCase009.hs:21:9: warning: [-Wincomplete-patterns (in -Wextra)]
 
 EmptyCase009.hs:33:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Bar MkDB2_u)
+    In a case alternative: Patterns not matched: Bar MkDB2_u
 
 EmptyCase009.hs:42:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Bar MkGB3)
+    In a case alternative: Patterns not matched: Bar MkGB3
index d4caf64..bfff6c7 100644 (file)
@@ -3,31 +3,31 @@ EmptyCase010.hs:24:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (Baz MkGC1)
-            (Baz (MkGC2 _))
+            Baz MkGC1
+            Baz (MkGC2 _)
 
 EmptyCase010.hs:28:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Baz MkGC1)
+    In a case alternative: Patterns not matched: Baz MkGC1
 
 EmptyCase010.hs:37:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (Baz MkGD1)
-            (Baz MkGD3)
+            Baz MkGD1
+            Baz MkGD3
 
 EmptyCase010.hs:41:9: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Baz MkGD3)
+    In a case alternative: Patterns not matched: Baz MkGD3
 
 EmptyCase010.hs:45:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns not matched:
-            (Baz MkGD1)
-            (Baz MkGD2)
-            (Baz MkGD3)
+            Baz MkGD1
+            Baz MkGD2
+            Baz MkGD3
 
 EmptyCase010.hs:57:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
@@ -35,7 +35,7 @@ EmptyCase010.hs:57:7: warning: [-Wincomplete-patterns (in -Wextra)]
 
 EmptyCase010.hs:69:7: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (Baz MkDC2)
+    In a case alternative: Patterns not matched: Baz MkDC2
 
 EmptyCase010.hs:73:9: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
index 5d479c3..d824b83 100644 (file)
@@ -1,4 +1,4 @@
 
 T11336b.hs:25:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In an equation for ‘fun’: Patterns not matched: _
+    In an equation for ‘fun’: Patterns not matched: _ :: Proxy a
index 7198efc..4cefed9 100644 (file)
@@ -1,9 +1,9 @@
 
 T11822.hs:33:1: warning:
     Pattern match checker ran into -fmax-pmcheck-models=100 limit, so
-       Redundant clauses might not be reported at all
-       Redundant clauses might be reported as inaccessible
-       Patterns reported as unmatched might actually be matched
+       Redundant clauses might not be reported at all
+       Redundant clauses might be reported as inaccessible
+       Patterns reported as unmatched might actually be matched
     Increase the limit or resolve the warnings to suppress this message.
 
 T11822.hs:33:1: warning: [-Wincomplete-patterns (in -Wextra)]
index 54cb90a..e760a2c 100644 (file)
@@ -1,4 +1,4 @@
 
 T15305.hs:48:23: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (MkAbyss _)
+    In a case alternative: Patterns not matched: MkAbyss _
index 8eaa4ab..84c360b 100644 (file)
@@ -1,4 +1,5 @@
 
 pmc009.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In an equation for ‘addPatSynSelector’: Patterns not matched: _
+    In an equation for ‘addPatSynSelector’:
+        Patterns not matched: _ :: LHsBind p
index 00272ef..8b96c48 100644 (file)
@@ -1,4 +1,4 @@
 
 WerrorFail.hs:6:1: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
     Pattern match(es) are non-exhaustive
-    In an equation for ‘foo’: Patterns not matched: (Just _)
+    In an equation for ‘foo’: Patterns not matched: Just _
index f6105d1..afbcd61 100644 (file)
@@ -4,7 +4,7 @@ WerrorFail2.hs:15:1: warning: [-Wmissing-signatures (in -Wall)]
 
 WerrorFail2.hs:15:10: error: [-Wincomplete-patterns (in -Wextra), -Werror=incomplete-patterns]
     Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: (C2 _)
+    In a case alternative: Patterns not matched: C2 _
 
 WerrorFail2.hs:19:1: warning: [-Wmissing-signatures (in -Wall)]
     Top-level binding with no type signature: printRec :: IO ()