[Git][ghc/ghc][wip/pmcheck-ncon] 2 commits: go_grp doesn't need to be in MaybeT

[Sebastian Graf]

Sebastian Graf pushed to branch wip/pmcheck-ncon at Glasgow Haskell Compiler / GHC


Commits:
2d2f61c0 by Sebastian Graf at 2019-06-23T07:57:13Z
go_grp doesn't need to be in MaybeT

- - - - -
310027ea by Sebastian Graf at 2019-06-23T07:57:30Z
Accept output of completesig06

- - - - -


2 changed files:

- compiler/deSugar/Check.hs
- testsuite/tests/pmcheck/complete_sigs/completesig06.stderr


Changes:

=====================================
compiler/deSugar/Check.hs
=====================================
@@ -620,14 +620,14 @@ normaliseValAbs delta = runMaybeT . go_va delta
       pure (delta', pm { pm_con_args = args' })
     go_va delta va@(PmVar x) = do
       grps <- lift (allCompleteMatches (idType x))
-      incomplete_grps <- traverse (go_grp 0 x delta) grps
+      incomplete_grps <- lift (traverse (go_grp 0 x delta) grps)
       -- If all cons of any COMPLETE set are matched, the ValAbs is vacuous.
       lift $ tracePm "normaliseValAbs" (ppr x <+> ppr (idType x) <+> ppr grps <+> ppr incomplete_grps)
       guard (all notNull incomplete_grps)
       -- If there's a unique singleton incomplete group, turn it into a
       -- @PmCon@ for better readability of warning messages.
       case incomplete_grps of
-        [[con]] -> do
+        ([con]:_) | all (== [con]) incomplete_grps -> do
           -- We don't want to simplify to a @PmCon@ (which won't normalise
           -- any further) when @p@ is just the 'cheapInhabitationTest'.
           -- Thus, we have to assert satisfiability here, even if the
@@ -639,7 +639,7 @@ normaliseValAbs delta = runMaybeT . go_va delta
         _        -> pure (delta, va)
     go_va delta va = pure (delta, va)
 
-    go_grp :: Int -> Id -> Delta -> [ConLike] -> MaybeT PmM [ConLike]
+    go_grp :: Int -> Id -> Delta -> [ConLike] -> PmM [ConLike]
     go_grp _ _ _ []
       = pure []
     go_grp n_inh _ _ group
@@ -649,7 +649,7 @@ normaliseValAbs delta = runMaybeT . go_va delta
       -- For huge groups, this saves a lot of unnecessary oracle queries!
       = pure group
     go_grp n_inh x delta (con:group) = do
-      mb_delta_ic <- lift (mkOneSatisfiableConFull delta x con)
+      mb_delta_ic <- mkOneSatisfiableConFull delta x con
       case mb_delta_ic of
         Nothing -> go_grp n_inh x delta group
         Just _  -> (con:) <$> go_grp (n_inh + 1) x delta group


=====================================
testsuite/tests/pmcheck/complete_sigs/completesig06.stderr
=====================================
@@ -1,7 +1,8 @@
 
 completesig06.hs:13:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
-    In an equation for ‘m1’: Patterns not matched: B
+    In an equation for ‘m1’:
+        Patterns not matched: p where p is not one of {A}
 
 completesig06.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
@@ -10,20 +11,16 @@ completesig06.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)]
 completesig06.hs:20:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In an equation for ‘m3’:
-        Patterns not matched:
-            A
-            B
+        Patterns not matched: p where p is not one of {C}
 
 completesig06.hs:23:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In an equation for ‘m4’:
         Patterns not matched:
-            B D
             A D
+            B D
 
 completesig06.hs:29:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In an equation for ‘m5’:
-        Patterns not matched:
-            A _
-            B _
+        Patterns not matched: p _ where p is not one of {C}



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b9d1a3c002f97a57e1f9056dd975ea17a82d41ad...310027eae433147fa7b3de6e6c840c7d28f37c0c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b9d1a3c002f97a57e1f9056dd975ea17a82d41ad...310027eae433147fa7b3de6e6c840c7d28f37c0c
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190623/85b3bc77/attachment-0001.html>