Commit 4082460e authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Show the CType in --show-iface output

parent 40cb7f14
...@@ -455,21 +455,23 @@ pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ...@@ -455,21 +455,23 @@ pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
pprIfaceDecl (IfaceForeign {ifName = tycon}) pprIfaceDecl (IfaceForeign {ifName = tycon})
= hsep [ptext (sLit "foreign import type dotnet"), ppr 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}) ifSynRhs = Just mono_ty})
= hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars) = 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, pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
ifSynRhs = Nothing, ifSynKind = kind }) ifSynRhs = Nothing, ifSynKind = kind })
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars) = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
4 (dcolon <+> ppr kind) 4 (dcolon <+> ppr kind)
pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context, pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
ifCtxt = context,
ifTyVars = tyvars, ifCons = condecls, ifTyVars = tyvars, ifCons = condecls,
ifRec = isrec, ifAxiom = mbAxiom}) ifRec = isrec, ifAxiom = mbAxiom})
= hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars) = 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]) pprAxiom mbAxiom])
where where
pp_nd = case condecls of pp_nd = case condecls of
...@@ -491,6 +493,10 @@ pprIfaceDecl (IfaceAxiom {ifName = name, ifTyVars = tyvars, ...@@ -491,6 +493,10 @@ pprIfaceDecl (IfaceAxiom {ifName = name, ifTyVars = tyvars,
= hang (ptext (sLit "axiom") <+> ppr name <+> ppr tyvars) = hang (ptext (sLit "axiom") <+> ppr name <+> ppr tyvars)
2 (dcolon <+> ppr lhs <+> text "~#" <+> ppr rhs) 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 :: RecFlag -> SDoc
pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
......
...@@ -234,10 +234,19 @@ instance Outputable CCallSpec where ...@@ -234,10 +234,19 @@ instance Outputable CCallSpec where
newtype Header = Header FastString newtype Header = Header FastString
deriving (Eq, Data, Typeable) deriving (Eq, Data, Typeable)
instance Outputable Header where
ppr (Header h) = quotes $ ppr h
-- | A C type, used in CAPI FFI calls -- | A C type, used in CAPI FFI calls
data CType = CType (Maybe Header) -- header to include for this type data CType = CType (Maybe Header) -- header to include for this type
FastString -- the type itself FastString -- the type itself
deriving (Data, Typeable) 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} \end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment