[commit: ghc] master: Allow bundling pattern synonyms with exported data families (29f07b1)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/29f07b1de78198fa29dabafd7bf1f1f4ecdc7f54/ghc

>---------------------------------------------------------------

commit 29f07b1de78198fa29dabafd7bf1f1f4ecdc7f54
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Mon Jul 31 22:33:40 2017 -0400

    Allow bundling pattern synonyms with exported data families
    
    Test Plan: make test TEST=T14058
    
    Reviewers: mpickering, austin, bgamari, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: simonpj, rwbarton, thomie
    
    GHC Trac Issues: #14058
    
    Differential Revision: https://phabricator.haskell.org/D3808


>---------------------------------------------------------------

29f07b1de78198fa29dabafd7bf1f1f4ecdc7f54
 compiler/types/TyCon.hs                          |  6 ++++++
 testsuite/tests/patsyn/should_compile/T14058.hs  |  7 +++++++
 testsuite/tests/patsyn/should_compile/T14058a.hs | 19 +++++++++++++++++++
 testsuite/tests/patsyn/should_compile/all.T      |  2 ++
 4 files changed, 34 insertions(+)

diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index cf144eb..95207c4 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -2108,6 +2108,10 @@ expandSynTyCon_maybe tc tys
 -- | Check if the tycon actually refers to a proper `data` or `newtype`
 --  with user defined constructors rather than one from a class or other
 --  construction.
+
+-- NB: This is only used in TcRnExports.checkPatSynParent to determine if an
+-- exported tycon can have a pattern synonym bundled with it, e.g.,
+-- module Foo (TyCon(.., PatSyn)) where
 isTyConWithSrcDataCons :: TyCon -> Bool
 isTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) =
   case rhs of
@@ -2117,6 +2121,8 @@ isTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) =
     _ -> False
   where
     isSrcParent = isNoParent parent
+isTyConWithSrcDataCons (FamilyTyCon { famTcFlav = DataFamilyTyCon {} })
+                         = True -- #14058
 isTyConWithSrcDataCons _ = False
 
 
diff --git a/testsuite/tests/patsyn/should_compile/T14058.hs b/testsuite/tests/patsyn/should_compile/T14058.hs
new file mode 100644
index 0000000..7c263b8
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T14058.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeInType #-}
+module T14058 where
+
+import T14058a (Sing(..))
+
+foo :: Sing ('[ '[] ] :: [[a]])
+foo = SCons SNil SNil
diff --git a/testsuite/tests/patsyn/should_compile/T14058a.hs b/testsuite/tests/patsyn/should_compile/T14058a.hs
new file mode 100644
index 0000000..a7e5d97
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T14058a.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+module T14058a (Sing(.., SCons)) where
+
+data family Sing (a :: k)
+
+data instance Sing (z :: [a]) where
+  SNil :: Sing '[]
+  (:%) :: Sing x -> Sing xs -> Sing (x:xs)
+
+pattern SCons :: forall a (z :: [a]). ()
+              => forall (x :: a) (xs :: [a]). z ~ (x:xs)
+              => Sing x -> Sing xs -> Sing z
+pattern SCons x xs = (:%) x xs
+{-# COMPLETE SNil, SCons #-}
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 286f735..b8c9806 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -71,3 +71,5 @@ test('T13454', normal, compile, [''])
 test('T13752', normal, compile, [''])
 test('T13752a', normal, compile, [''])
 test('T13768', normal, compile, [''])
+test('T14058', [extra_files(['T14058.hs', 'T14058a.hs'])],
+               multimod_compile, ['T14058', '-v0'])