[commit: ghc] ghc-7.8: Check for un-saturated type family applications (de53111)

[git at git.haskell.org]

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

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/de531119362b343978c0a38d4fa75e80103baaa1/ghc

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

commit de531119362b343978c0a38d4fa75e80103baaa1
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Aug 25 15:13:02 2014 +0100

    Check for un-saturated type family applications
    
    This patch corrects an egregious error introduced by:
    
      commit 022f8750edf6f413fba31293435dcc62600eab77
      Author: Simon Peyton Jones <simonpj at microsoft.com>
      Date:   Thu May 15 16:07:04 2014 +0100
    
        Refactoring around TyCon.isSynTyCon
    
        * Document isSynTyCon better
        * Add isTypeSyonymTyCon for regular H98 type synonyms
        * Use isTypeSynonymTyCon rather than isSynTyCon where
          the former is really intended
    
    At this particular spot in TcValidity we really do mean
    isSynTyCon and not isTypeSynonymTyCon.
    
    Fixes Trac #9433
    
    (cherry picked from commit ee4501bbad6480509e8a60b5ff89c0b0b228b66d)
    
    Conflicts:
    	testsuite/tests/indexed-types/should_fail/all.T


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

de531119362b343978c0a38d4fa75e80103baaa1
 compiler/typecheck/TcValidity.lhs                      |  5 ++++-
 testsuite/tests/indexed-types/should_fail/T9433.hs     | 15 +++++++++++++++
 testsuite/tests/indexed-types/should_fail/T9433.stderr |  4 ++++
 testsuite/tests/indexed-types/should_fail/all.T        |  1 +
 4 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index ebb375d..7e73ee6 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -290,7 +290,7 @@ check_type ctxt rank (AppTy ty1 ty2)
         ; check_arg_type ctxt rank ty2 }
 
 check_type ctxt rank ty@(TyConApp tc tys)
-  | isTypeSynonymTyCon tc  = check_syn_tc_app ctxt rank ty tc tys
+  | isSynTyCon tc          = check_syn_tc_app ctxt rank ty tc tys
   | isUnboxedTupleTyCon tc = check_ubx_tuple  ctxt      ty    tys
   | otherwise              = mapM_ (check_arg_type ctxt rank) tys
 
@@ -301,6 +301,9 @@ check_type _ _ ty = pprPanic "check_type" (ppr ty)
 ----------------------------------------
 check_syn_tc_app :: UserTypeCtxt -> Rank -> KindOrType 
                  -> TyCon -> [KindOrType] -> TcM ()
+-- Used for type synonyms and type synonym families,
+-- which must be saturated, 
+-- but not data families, which need not be saturated
 check_syn_tc_app ctxt rank ty tc tys
   | tc_arity <= n_args   -- Saturated
        -- Check that the synonym has enough args
diff --git a/testsuite/tests/indexed-types/should_fail/T9433.hs b/testsuite/tests/indexed-types/should_fail/T9433.hs
new file mode 100644
index 0000000..c7b6161
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9433.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE
+     TypeFamilies
+   , KindSignatures
+   #-}
+
+module T9433 where
+
+type family Id x :: *
+type instance Id a = a
+
+type family Map (f :: * -> *) x :: *
+type instance Map f [a] = [f a]
+
+x :: Map Id [Bool]
+x = []
diff --git a/testsuite/tests/indexed-types/should_fail/T9433.stderr b/testsuite/tests/indexed-types/should_fail/T9433.stderr
new file mode 100644
index 0000000..0b17f57
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9433.stderr
@@ -0,0 +1,4 @@
+
+T9433.hs:14:6:
+    Type synonym ‘Id’ should have 1 argument, but has been given none
+    In the type signature for ‘x’: x :: Map Id [Bool]
diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T
index 5340574..dde335d 100644
--- a/testsuite/tests/indexed-types/should_fail/all.T
+++ b/testsuite/tests/indexed-types/should_fail/all.T
@@ -120,3 +120,4 @@ test('T8368', normal, compile_fail, [''])
 test('T8368a', normal, compile_fail, [''])
 test('T8518', normal, compile_fail, [''])
 test('T9160', normal, compile_fail, [''])
+test('T9433', normal, compile_fail, [''])