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@xxxxxxxx>
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}





_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@xxxxxxxxxxx
http://www.haskell.org/mailman/listinfo/cvs-ghc