X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FPprTyThing.hs;h=dfa713fdc0b13276cc52d5ee9ba06ed3cf7e602d;hp=e57122b721fdb12bccb9c5e2f2d9a5e2739ebfe4;hb=215ce9f15215399ce30ae55c9521087847d78646;hpb=d74b100eaa9e782710b752805ac148e91e5c6850

diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index e57122b..dfa713f 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -16,17 +16,15 @@ module PprTyThing (
   	pprTypeForUser
   ) where
 
-#include "HsVersions.h"
-
 import qualified GHC
 
 import GHC ( TyThing(..) )
 import TyCon
-import Type ( TyThing(..), tidyTopType, pprTypeApp )
 import TcType
 import Var
 import Name
 import Outputable
+import FastString
 
 -- -----------------------------------------------------------------------------
 -- Pretty-printing entities that we get from the GHC API
@@ -77,7 +75,7 @@ pprTyThingHdr pefas (AClass cls)       = pprClassHdr   pefas cls
 pprTyConHdr :: PrintExplicitForalls -> TyCon -> SDoc
 pprTyConHdr _ tyCon
   | Just (_fam_tc, tys) <- tyConFamInst_maybe tyCon
-  = ptext keyword <+> ptext SLIT("instance") <+> pprTypeApp tyCon (ppr_bndr tyCon) tys
+  = ptext keyword <+> ptext (sLit "instance") <+> pprTypeApp tyCon tys
   | otherwise
   = ptext keyword <+> opt_family <+> opt_stupid <+> ppr_bndr tyCon <+> hsep (map ppr vars)
   where
@@ -85,12 +83,12 @@ pprTyConHdr _ tyCon
 	   GHC.isFunTyCon tyCon = take (GHC.tyConArity tyCon) GHC.alphaTyVars
 	 | otherwise = GHC.tyConTyVars tyCon
 
-    keyword | GHC.isSynTyCon tyCon = SLIT("type")
-            | GHC.isNewTyCon tyCon = SLIT("newtype")
-            | otherwise            = SLIT("data")
+    keyword | GHC.isSynTyCon tyCon = sLit "type"
+            | GHC.isNewTyCon tyCon = sLit "newtype"
+            | otherwise            = sLit "data"
 
     opt_family
-      | GHC.isOpenTyCon tyCon = ptext SLIT("family")
+      | GHC.isOpenTyCon tyCon = ptext (sLit "family")
       | otherwise             = empty
 
     opt_stupid 	-- The "stupid theta" part of the declaration
@@ -104,7 +102,7 @@ pprDataConSig pefas dataCon =
 pprClassHdr :: PrintExplicitForalls -> GHC.Class -> SDoc
 pprClassHdr _ cls =
   let (tyVars, funDeps) = GHC.classTvsFds cls
-  in ptext SLIT("class") <+> 
+  in ptext (sLit "class") <+> 
      GHC.pprThetaArrow (GHC.classSCTheta cls) <+>
      ppr_bndr cls <+>
      hsep (map ppr tyVars) <+>
@@ -160,7 +158,7 @@ pprTyCon pefas tyCon
 pprAlgTyCon :: PrintExplicitForalls -> TyCon -> (GHC.DataCon -> Bool)
             -> (FieldLabel -> Bool) -> SDoc
 pprAlgTyCon pefas tyCon ok_con ok_label
-  | gadt      = pprTyConHdr pefas tyCon <+> ptext SLIT("where") $$ 
+  | gadt      = pprTyConHdr pefas tyCon <+> ptext (sLit "where") $$ 
 		   nest 2 (vcat (ppr_trim show_con datacons))
   | otherwise = hang (pprTyConHdr pefas tyCon)
     		   2 (add_bars (ppr_trim show_con datacons))
@@ -192,20 +190,16 @@ pprDataConDecl _ gadt_style show_label dataCon
 
     ppr_tvs 
 	| null qualVars = empty
-	| otherwise     = ptext SLIT("forall") <+> 
+	| otherwise     = ptext (sLit "forall") <+> 
 				hsep (map ppr qualVars) <> dot
 
 	-- printing out the dataCon as a type signature, in GADT style
     pp_tau = foldr add (ppr res_ty) tys_w_strs
     add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
 
-    pprParendBangTy (strict,ty)
-	| GHC.isMarkedStrict strict = char '!' <> GHC.pprParendType ty
-	| otherwise		    = GHC.pprParendType ty
+    pprParendBangTy (bang,ty) = ppr bang <> GHC.pprParendType ty
 
-    pprBangTy strict ty
-	| GHC.isMarkedStrict strict = char '!' <> ppr ty
-	| otherwise		    = ppr ty
+    pprBangTy bang ty = ppr bang <> ppr ty
 
     maybe_show_label (lbl,(strict,tp))
 	| show_label lbl = Just (ppr lbl <+> dcolon <+> pprBangTy strict tp)
@@ -213,7 +207,7 @@ pprDataConDecl _ gadt_style show_label dataCon
 
     ppr_fields [ty1, ty2]
 	| GHC.dataConIsInfix dataCon && null labels
-	= sep [pprParendBangTy ty1, ppr dataCon, pprParendBangTy ty2]
+	= sep [pprParendBangTy ty1, pprInfixName dataCon, pprParendBangTy ty2]
     ppr_fields fields
 	| null labels
 	= ppr_bndr dataCon <+> sep (map pprParendBangTy fields)
@@ -227,14 +221,14 @@ pprClass pefas cls
   | null methods = 
 	pprClassHdr pefas cls
   | otherwise = 
-	hang (pprClassHdr pefas cls <+> ptext SLIT("where"))
+	hang (pprClassHdr pefas cls <+> ptext (sLit "where"))
 	    2 (vcat (map (pprClassMethod pefas) methods))
   where
 	methods = GHC.classMethods cls
 
 pprClassOneMethod :: PrintExplicitForalls -> GHC.Class -> Id -> SDoc
 pprClassOneMethod pefas cls this_one
-  = hang (pprClassHdr pefas cls <+> ptext SLIT("where"))
+  = hang (pprClassHdr pefas cls <+> ptext (sLit "where"))
 	 2 (vcat (ppr_trim show_meth methods))
   where
 	methods = GHC.classMethods cls
@@ -267,7 +261,7 @@ ppr_trim show xs
     go x (eliding, so_far)
 	| Just doc <- show x = (False, doc : so_far)
 	| otherwise = if eliding then (True, so_far)
-		                 else (True, ptext SLIT("...") : so_far)
+		                 else (True, ptext (sLit "...") : so_far)
 
 add_bars :: [SDoc] -> SDoc
 add_bars []      = empty
@@ -283,5 +277,5 @@ showWithLoc loc doc
     = hang doc 2 (char '\t' <> comment <+> loc)
 		-- The tab tries to make them line up a bit
   where
-    comment = ptext SLIT("--")
+    comment = ptext (sLit "--")