SpliceDecl(..),
-- ** Foreign function interface declarations
ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
- CImportSpec(..), FoType(..),
+ CImportSpec(..),
-- ** Data-constructor declarations
- ConDecl(..), LConDecl, ResType(..), ConDeclField(..),
+ ConDecl(..), LConDecl, ResType(..),
HsConDeclDetails, hsConDeclArgTys, hsConDeclsNames,
-- ** Document comments
DocDecl(..), LDocDecl, docDeclDoc,
data TyClDecl name
= ForeignType {
tcdLName :: Located name,
- tcdExtName :: Maybe FastString,
- tcdFoType :: FoType
+ tcdExtName :: Maybe FastString
}
-- ^ Type variables. Depending on 'con_res' this describes the
-- follewing entities
--
- -- - ResTyH98: the constructor's existential type variables
- --
- -- - ResTyGADT: all the constructor's quantified type variables
+ -- - ResTyH98: the constructor's *existential* type variables
+ -- - ResTyGADT: *all* the constructor's quantified type variables
, con_cxt :: LHsContext name
-- ^ The context. This /does not/ include the \"stupid theta\" which
, con_doc :: Maybe (LHsDoc name)
-- ^ A possible Haddock comment.
+
+ , con_old_rec :: Bool
+ -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
+ -- GADT-style record decl C { blah } :: T a b
+ -- Remove this when we no longer parse this stuff, and hence do not
+ -- need to report decprecated use
}
type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
-data ConDeclField name -- Record fields have Haddoc docs on them
- = ConDeclField { cd_fld_name :: Located name,
- cd_fld_type :: LBangType name,
- cd_fld_doc :: Maybe (LHsDoc name) }
-
data ResType name
= ResTyH98 -- Constructor was declared using Haskell 98 syntax
| ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
-- and here is its result type
+
+instance OutputableBndr name => Outputable (ResType name) where
+ -- Debugging only
+ ppr ResTyH98 = ptext (sLit "ResTyH98")
+ ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
\end{code}
\begin{code}
ppr = pprConDecl
pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
-pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
+pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
+ , con_cxt = cxt, con_details = details
+ , con_res = ResTyH98, con_doc = doc })
= sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
where
ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
- ppr_details con (RecCon fields) = ppr con <+> ppr_fields fields
+ ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
-pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
+pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
+ , con_cxt = cxt, con_details = PrefixCon arg_tys
+ , con_res = ResTyGADT res_ty })
= ppr con <+> dcolon <+>
sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
where
mk_fun_ty a b = noLoc (HsFunTy a b)
-pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
- = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
+pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
+ , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
+ = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
+ pprConDeclFields fields <+> arrow <+> ppr res_ty]
-pprConDecl (ConDecl con _expl _tvs _cxt (InfixCon _ _) (ResTyGADT _res_ty) _)
+pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
= pprPanic "pprConDecl" (ppr con)
-- In GADT syntax we don't allow infix constructors
-
-
-ppr_fields :: OutputableBndr name => [ConDeclField name] -> SDoc
-ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
- where
- ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
- cd_fld_doc = doc })
- = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
\end{code}
%************************************************************************
FastString -- name of C header
CImportSpec -- details of the C entity
- -- import of a .NET function
- --
- | DNImport DNCallSpec
-
-- details of an external C entity
--
data CImportSpec = CLabel CLabelString -- import address of a C label
-- convention
--
data ForeignExport = CExport CExportSpec -- contains the calling convention
- | DNExport -- presently unused
-
--- abstract type imported from .NET
---
-data FoType = DNType -- In due course we'll add subtype stuff
- deriving (Eq) -- Used for equality instance for TyClDecl
-
-- pretty printing of foreign declarations
--
2 (dcolon <+> ppr ty)
instance Outputable ForeignImport where
- ppr (DNImport spec) =
- ptext (sLit "dotnet") <+> ppr spec
ppr (CImport cconv safety header spec) =
ppr cconv <+> ppr safety <+>
char '"' <> pprCEntity spec <> char '"'
instance Outputable ForeignExport where
ppr (CExport (CExportStatic lbl cconv)) =
ppr cconv <+> char '"' <> ppr lbl <> char '"'
- ppr (DNExport ) =
- ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
-
-instance Outputable FoType where
- ppr DNType = ptext (sLit "type dotnet")
\end{code}
projects / ghc-hetmet.git / blobdiff