[commit: ghc] master: Show the CType in --show-iface output (4082460)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/4082460e01b81b48614c70876f6ce9b7820f39eb

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

commit 4082460e01b81b48614c70876f6ce9b7820f39eb
Author: Ian Lynagh <igloo at earth.li>
Date:   Tue Feb 21 19:19:55 2012 +0000

    Show the CType in --show-iface output

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

 compiler/iface/IfaceSyn.lhs      |   14 ++++++++++----
 compiler/prelude/ForeignCall.lhs |    9 +++++++++
 2 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 05a943f..62b8234 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -455,21 +455,23 @@ pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
 pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifCType = cType,
+                        ifTyVars = tyvars,
                         ifSynRhs = Just mono_ty})
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
-       4 (vcat [equals <+> ppr mono_ty])
+       4 (vcat [pprCType cType, equals <+> ppr mono_ty])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
                         ifSynRhs = Nothing, ifSynKind = kind })
   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (dcolon <+> ppr kind)
 
-pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
+pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
+                         ifCtxt = context,
                          ifTyVars = tyvars, ifCons = condecls,
                          ifRec = isrec, ifAxiom = mbAxiom})
   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
-       4 (vcat [pprRec isrec, pp_condecls tycon condecls,
+       4 (vcat [pprCType cType, pprRec isrec, pp_condecls tycon condecls,
                 pprAxiom mbAxiom])
   where
     pp_nd = case condecls of
@@ -491,6 +493,10 @@ pprIfaceDecl (IfaceAxiom {ifName = name, ifTyVars = tyvars,
   = hang (ptext (sLit "axiom") <+> ppr name <+> ppr tyvars)
        2 (dcolon <+> ppr lhs <+> text "~#" <+> ppr rhs)
 
+pprCType :: Maybe CType -> SDoc
+pprCType Nothing = ptext (sLit "No C type associated")
+pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType
+
 pprRec :: RecFlag -> SDoc
 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 
diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
index 0a8db5c..b245e83 100644
--- a/compiler/prelude/ForeignCall.lhs
+++ b/compiler/prelude/ForeignCall.lhs
@@ -234,10 +234,19 @@ instance Outputable CCallSpec where
 newtype Header = Header FastString
     deriving (Eq, Data, Typeable)
 
+instance Outputable Header where
+    ppr (Header h) = quotes $ ppr h
+
 -- | A C type, used in CAPI FFI calls
 data CType = CType (Maybe Header) -- header to include for this type
                    FastString     -- the type itself
     deriving (Data, Typeable)
+
+instance Outputable CType where
+    ppr (CType mh ct) = hDoc <+> ftext ct
+        where hDoc = case mh of
+                     Nothing -> empty
+                     Just h -> ppr h
 \end{code}