[commit: ghc] ghc-kinds: fix forbidden promotion of type families (390f3f3)

[Julien Cretin]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-kinds

http://hackage.haskell.org/trac/ghc/changeset/390f3f34797d28a02bab71ead27bbff2f4e48ee2

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

commit 390f3f34797d28a02bab71ead27bbff2f4e48ee2
Author: Julien Cretin <ghc at ia0.eu>
Date:   Fri Aug 26 14:23:30 2011 +0200

    fix forbidden promotion of type families

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

 compiler/TODO                   |    5 +++++
 compiler/typecheck/TcHsType.lhs |    3 ++-
 2 files changed, 7 insertions(+), 1 deletions(-)

diff --git a/compiler/TODO b/compiler/TODO
index 2cf2282..e52fb9d 100644
--- a/compiler/TODO
+++ b/compiler/TODO
@@ -17,6 +17,11 @@
 * Do some sharing for promoted things, so that when I lookup K in a
   type, I verify only once that it is promotable, and I don't build
   several identical PromotedDataTyCon.
+  Add field about promotion:
+  - in DataCon: Maybe TyCon (the promoted TyCon)
+  - in AlgTyCon: Maybe Int which means
+    - T's kind is promotable (Just n)  *^n -> *
+    - all its DataCon are promotable
 
 * Error messages for things like:
   data T a = K (a K)
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 4646d09..fd450c7 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -1118,7 +1118,8 @@ sc_ds_var_app name arg_kis = do
   thing <- tcLookup name
   traceTc "lps2" (ppr name <+> ppr thing)
   case thing of
-    AGlobal (ATyCon tc) -> do
+    AGlobal (ATyCon tc)
+      | isAlgTyCon tc || isTupleTyCon tc -> do
       let tc_kind = tyConKind tc
       case isPromotableKind tc_kind of
         Just n | n == length arg_kis -> return (mkTyConApp tc arg_kis)