[Git][ghc/ghc][wip/T24326] Pmc: COMPLETE pragmas associated with Family TyCons should apply to...

[Sebastian Graf (@sgraf812)]

Sebastian Graf pushed to branch wip/T24326 at Glasgow Haskell Compiler / GHC


Commits:
1e0876d4 by Sebastian Graf at 2024-01-11T13:40:56+01:00
Pmc: COMPLETE pragmas associated with Family TyCons should apply to representation TyCons as well (#24326)

Fixes #24326.

- - - - -


3 changed files:

- compiler/GHC/Types/CompleteMatch.hs
- + testsuite/tests/pmcheck/complete_sigs/T24326.hs
- testsuite/tests/pmcheck/complete_sigs/all.T


Changes:

=====================================
compiler/GHC/Types/CompleteMatch.hs
=====================================
@@ -35,6 +35,11 @@ completeMatchAppliesAtType ty cm = all @Maybe ty_matches (cmResultTyCon cm)
     ty_matches sig_tc
       | Just (tc, _arg_tys) <- splitTyConApp_maybe ty
       , tc == sig_tc
+      || sig_tc `is_family_ty_con_of` tc
+         -- #24326: sig_tc might be the data Family TyCon of the representation
+         --         TyCon tc -- this CompleteMatch still applies
       = True
       | otherwise
       = False
+    fam_tc `is_family_ty_con_of` repr_tc =
+      (fst <$> tyConFamInst_maybe repr_tc) == Just fam_tc


=====================================
testsuite/tests/pmcheck/complete_sigs/T24326.hs
=====================================
@@ -0,0 +1,32 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module T24326 where
+
+data family Foo
+data instance Foo = A | B
+{-# COMPLETE A :: Foo #-}
+
+class C a where
+  matches :: a -> Bool
+
+pattern P :: C a => a
+pattern P <- (matches -> True)
+
+data D = D Bool
+instance C D where { matches (D b) = b }
+
+data family B a
+data instance B Bool = BBool Bool
+instance C (B Bool) where { matches (BBool b) = b }
+{-# COMPLETE P :: B #-}
+
+f :: Foo -> Int
+f A = 0 -- should not warn
+
+f1 :: D -> ()
+f1 P = () -- should warn, because COMPLETE doesn't apply at D
+
+f2 :: B Bool -> ()
+f2 P = () -- should not warn


=====================================
testsuite/tests/pmcheck/complete_sigs/all.T
=====================================
@@ -29,3 +29,4 @@ test('T18277', normal, compile, [''])
 test('T18960', normal, compile, [''])
 test('T18960b', normal, compile, [''])
 test('T19475', normal, compile, [''])
+test('T24326', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e0876d4bf0dba0a09f577b74a7b65606dd5d27c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e0876d4bf0dba0a09f577b74a7b65606dd5d27c
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/20240111/7e85c685/attachment-0001.html>