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

On branch  : ghc-7.6

http://hackage.haskell.org/trac/ghc/changeset/e3dc71de7307d30f6063a8447b93e54f1551a041

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

commit e3dc71de7307d30f6063a8447b93e54f1551a041
Author: Simon Peyton Jones <simo...@microsoft.com>
Date:   Wed Dec 5 11:07:38 2012 +0000

    Allow existential data constructors to be promoted
    
    This reverts the change in Trac #7347, which prevented promotion
    of existential data constructors.  Ones with constraints in
    their types, or kind polymorphism, still can't be promoted.

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

 compiler/basicTypes/DataCon.lhs |    8 +++++---
 compiler/types/TyCon.lhs        |    6 ++++--
 2 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index c82f018..edb3627 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -391,6 +391,7 @@ data DataCon
                                -- The actual fixity is stored elsewhere
 
         dcPromoted :: Maybe TyCon    -- The promoted TyCon if this DataCon is 
promotable
+                                     -- See Note [Promoted data constructors] 
in TyCon
   }
   deriving Data.Typeable.Typeable
 
@@ -559,9 +560,10 @@ mkDataCon name declared_infix
          mkFunTys rep_arg_tys $
          mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
 
-    mb_promoted 
-      | is_vanilla   -- No existentials or context
-      , all (isLiftedTypeKind . tyVarKind) univ_tvs
+    mb_promoted   -- See Note [Promoted data constructors] in TyCon
+      | all (isLiftedTypeKind . tyVarKind) (univ_tvs ++ ex_tvs)
+                          -- No kind polymorphism, and all of kind *
+      , null full_theta   -- No constraints
       , all isPromotableType orig_arg_tys
       = Just (mkPromotedDataCon con name (getUnique name) prom_kind arity)
       | otherwise 
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 5398adc..e90cdec 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -581,8 +581,10 @@ Note [Promoted data constructors]
 A data constructor can be promoted to become a type constructor,
 via the PromotedTyCon alternative in TyCon.
 
-* Only "vanilla" data constructors are promoted; ones with no GADT
-  stuff, no existentials, etc.  We might generalise this later.
+* Only data constructors with  
+     (a) no kind polymorphism
+     (b) no constraints in its type (eg GADTs)
+  are promoted.  Existentials are ok; see Trac #7347.
 
 * The TyCon promoted from a DataCon has the *same* Name and Unique as
   the DataCon.  Eg. If the data constructor Data.Maybe.Just(unique 78,



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to