Wibbles to faa8ff40 (UNPACK pragmas)

Nothing big here, just tidying up deetails

1 files changed, 20 insertions, 4 deletions

diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index 0fa7bdff52..81d8e506c6 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -29,10 +29,12 @@ import GHC ( TyThing(..) )
 import DataCon
 import Id
 import TyCon
+import BasicTypes
 import Coercion( pprCoAxiom )
 import HscTypes( tyThingParent_maybe )
 import TcType
 import Name
+import StaticFlags( opt_PprStyle_Debug )
 import Outputable
 import FastString
 
@@ -203,7 +205,7 @@ pprDataConDecl pefas ss gadt_style dataCon
     (arg_tys, res_ty)        = tcSplitFunTys tau
     labels     = GHC.dataConFieldLabels dataCon
     stricts    = GHC.dataConStrictMarks dataCon
-    tys_w_strs = zip stricts arg_tys
+    tys_w_strs = zip (map user_ify stricts) arg_tys
     pp_foralls | pefas     = GHC.pprForAll forall_tvs
                | otherwise = empty
 
@@ -211,11 +213,17 @@ pprDataConDecl pefas ss gadt_style dataCon
     add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
 
     pprParendBangTy (bang,ty) = ppr bang <> GHC.pprParendType ty
+    pprBangTy       (bang,ty) = ppr bang <> ppr ty
 
-    pprBangTy bang ty = ppr bang <> ppr ty
+    -- See Note [Printing bangs on data constructors]
+    user_ify :: HsBang -> HsBang
+    user_ify bang | opt_PprStyle_Debug = bang
+    user_ify HsStrict                  = HsBang False
+    user_ify HsUnpack                  = HsBang True
+    user_ify bang                      = bang
 
-    maybe_show_label (lbl,(strict,tp))
-	| showSub ss lbl = Just (ppr lbl <+> dcolon <+> pprBangTy strict tp)
+    maybe_show_label (lbl,bty)
+	| showSub ss lbl = Just (ppr lbl <+> dcolon <+> pprBangTy bty)
 	| otherwise      = Nothing
 
     ppr_fields [ty1, ty2]
@@ -290,3 +298,11 @@ showWithLoc loc doc
   where
     comment = ptext (sLit "--")
 
+{- 
+Note [Printing bangs on data constructors] 
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For imported data constructors the dataConStrictMarks are the
+representation choices (see Note [Bangs on data constructor arguments]
+in DataCon.lhs). So we have to fiddle a little bit here to turn them
+back into user-printable form.
+-}