From 8b6c1605e75a2482892995c6d0529911796e89dd Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Tue, 25 May 2010 11:40:45 +0000
Subject: [PATCH] Improve printing of TyThings; fixes Trac #4087

---
 compiler/main/GHC.hs        |    4 ++--
 compiler/main/PprTyThing.hs |   22 ++++++++--------------
 2 files changed, 10 insertions(+), 16 deletions(-)

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index b713bc8..64042e2 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -158,7 +158,7 @@ module GHC (
 	-- ** Data constructors
 	DataCon,
 	dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
-	dataConIsInfix, isVanillaDataCon,
+	dataConIsInfix, isVanillaDataCon, dataConUserType,
 	dataConStrictMarks,  
 	StrictnessMark(..), isMarkedStrict,
 
@@ -176,7 +176,7 @@ module GHC (
 	pprParendType, pprTypeApp, 
 	Kind,
 	PredType,
-	ThetaType, pprThetaArrow,
+	ThetaType, pprForAll, pprThetaArrow,
 
 	-- ** Entities
 	TyThing(..), 
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index dfa713f..8bdb072 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -179,21 +179,15 @@ pprDataConDecl :: PrintExplicitForalls -> Bool -> (FieldLabel -> Bool)
 pprDataConDecl _ gadt_style show_label dataCon
   | not gadt_style = ppr_fields tys_w_strs
   | otherwise      = ppr_bndr dataCon <+> dcolon <+> 
-			sep [ ppr_tvs, GHC.pprThetaArrow theta, pp_tau ]
+			sep [ GHC.pprForAll forall_tvs, GHC.pprThetaArrow theta, pp_tau ]
+	-- Printing out the dataCon as a type signature, in GADT style
   where
-    (tyvars, theta, argTypes, res_ty) = GHC.dataConSig dataCon
-    tyCon = GHC.dataConTyCon dataCon
-    labels = GHC.dataConFieldLabels dataCon
-    qualVars = filter (flip notElem (GHC.tyConTyVars tyCon)) tyvars
-    stricts = GHC.dataConStrictMarks dataCon
-    tys_w_strs = zip stricts argTypes
-
-    ppr_tvs 
-	| null qualVars = empty
-	| otherwise     = ptext (sLit "forall") <+> 
-				hsep (map ppr qualVars) <> dot
-
-	-- printing out the dataCon as a type signature, in GADT style
+    (forall_tvs, theta, tau) = tcSplitSigmaTy (GHC.dataConUserType dataCon)
+    (arg_tys, res_ty)        = tcSplitFunTys tau
+    labels     = GHC.dataConFieldLabels dataCon
+    stricts    = GHC.dataConStrictMarks dataCon
+    tys_w_strs = zip stricts arg_tys
+
     pp_tau = foldr add (ppr res_ty) tys_w_strs
     add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
 
-- 
1.7.10.4