Always pay attention to -keep-tmp-files when we want to delete files

[ghc-hetmet.git] / compiler / main / PprTyThing.hs

diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index 2763b05..51144ec 100644 (file)
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -17,7 +17,9 @@ module PprTyThing (
 #include "HsVersions.h"
 
 import qualified GHC
+
 import GHC ( TyThing(..), SrcLoc )
+import DataCon ( dataConResTys )
 import Outputable
 
 -- -----------------------------------------------------------------------------
@@ -65,7 +67,7 @@ pprTyThingHdr exts (ATyCon tyCon)     = pprTyConHdr   exts tyCon
 pprTyThingHdr exts (AClass cls)       = pprClassHdr   exts cls
         
 pprTyConHdr exts tyCon =
-  ptext keyword <+> ppr_bndr tyCon <+> hsep (map ppr vars)
+  addFamily (ptext keyword) <+> ppr_bndr tyCon <+> hsep (map ppr vars)
   where
     vars | GHC.isPrimTyCon tyCon || 
           GHC.isFunTyCon tyCon = take (GHC.tyConArity tyCon) GHC.alphaTyVars
@@ -75,6 +77,10 @@ pprTyConHdr exts tyCon =
             | GHC.isNewTyCon tyCon = SLIT("newtype")
             | otherwise            = SLIT("data")
 
+    addFamily keytext 
+      | GHC.isOpenTyCon tyCon = keytext <> ptext SLIT(" family")
+      | otherwise             = keytext
+
 pprDataConSig exts dataCon =
   ppr_bndr dataCon <+> dcolon <+> pprType exts (GHC.dataConType dataCon)
 
@@ -107,8 +113,12 @@ pprType False ty = ppr (GHC.dropForAlls ty)
 
 pprTyCon exts tyCon
   | GHC.isSynTyCon tyCon
-  = let rhs_type = GHC.synTyConRhs tyCon
-    in hang (pprTyConHdr exts tyCon <+> equals) 2 (pprType exts rhs_type)
+  = if GHC.isOpenTyCon tyCon
+    then pprTyConHdr exts tyCon <+> dcolon <+> 
+        pprType exts (GHC.synTyConResKind tyCon)
+    else 
+      let rhs_type = GHC.synTyConType tyCon
+      in hang (pprTyConHdr exts tyCon <+> equals) 2 (pprType exts rhs_type)
   | otherwise
   = pprAlgTyCon exts tyCon (const True) (const True)
 
@@ -133,8 +143,10 @@ pprDataConDecl exts gadt_style show_label dataCon
   | otherwise      = ppr_bndr dataCon <+> dcolon <+> 
                        sep [ ppr_tvs, GHC.pprThetaArrow theta, pp_tau ]
   where
-    (tyvars, theta, argTypes, tyCon, res_tys) = GHC.dataConSig dataCon
+    (tyvars, theta, argTypes) = GHC.dataConSig dataCon
+    tyCon = GHC.dataConTyCon dataCon
     labels = GHC.dataConFieldLabels dataCon
+    res_tys = dataConResTys dataCon
     qualVars = filter (flip notElem (GHC.tyConTyVars tyCon)) tyvars
     stricts = GHC.dataConStrictMarks dataCon
     tys_w_strs = zip stricts argTypes
@@ -146,7 +158,7 @@ pprDataConDecl exts gadt_style show_label dataCon
 
        -- printing out the dataCon as a type signature, in GADT style
     pp_tau = foldr add pp_res_ty tys_w_strs
-    pp_res_ty = ppr_bndr tyCon <+> hsep (map GHC.pprParendType res_tys)
+    pp_res_ty = GHC.pprTypeApp (ppr_bndr tyCon) res_tys
     add (str,ty) pp_ty = pprBangTy str ty <+> arrow <+> pp_ty
 
     pprParendBangTy (strict,ty)