--------------------------
Allow data type declarations
to have zero constructors
--------------------------
This allows
data T a
as a data type declaration; i.e. allows zero constructors.
If there is an '=' sign there must be at least one constructor.
* Parser.y: parse the declaration
* HsDecls: print out the data type declaration right
* TyCon: don't ASSERT that the constructors are non-empty
ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = ncons,
tcdDerivs = derivings})
ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = ncons,
tcdDerivs = derivings})
- = pp_tydecl (ptext keyword <+> pp_decl_head context tycon tyvars <+> equals)
+ = pp_tydecl (ptext keyword <+> pp_decl_head context tycon tyvars)
(pp_condecls condecls ncons)
derivings
where
(pp_condecls condecls ncons)
derivings
where
pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
pp_condecls [] ncons = ptext SLIT("{- abstract with") <+> int ncons <+> ptext SLIT("constructors -}")
pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
pp_condecls [] ncons = ptext SLIT("{- abstract with") <+> int ncons <+> ptext SLIT("constructors -}")
-pp_condecls (c:cs) ncons = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
+pp_condecls (c:cs) ncons = equals <+> sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
pp_tydecl pp_head pp_decl_rhs derivings
= hang pp_head 4 (sep [
pp_tydecl pp_head pp_decl_rhs derivings
= hang pp_head 4 (sep [
{-
-----------------------------------------------------------------------------
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.66 2001/05/24 13:59:11 simonpj Exp $
+$Id: Parser.y,v 1.67 2001/06/11 12:21:17 simonpj Exp $
-- Instead we just say b is out of scope
{ RdrHsDecl (TyClD (TySynonym (fst $3) (snd $3) $5 $1)) }
-- Instead we just say b is out of scope
{ RdrHsDecl (TyClD (TySynonym (fst $3) (snd $3) $5 $1)) }
- | srcloc 'data' ctype '=' constrs deriving
+ | srcloc 'data' ctype constrs deriving
{% checkDataHeader $3 `thenP` \(cs,c,ts) ->
returnP (RdrHsDecl (TyClD
{% checkDataHeader $3 `thenP` \(cs,c,ts) ->
returnP (RdrHsDecl (TyClD
- (mkTyData DataType cs c ts (reverse $5) (length $5) $6 $1))) }
+ (mkTyData DataType cs c ts (reverse $4) (length $4) $5 $1))) }
| srcloc 'newtype' ctype '=' newconstr deriving
{% checkDataHeader $3 `thenP` \(cs,c,ts) ->
| srcloc 'newtype' ctype '=' newconstr deriving
{% checkDataHeader $3 `thenP` \(cs,c,ts) ->
{ mkConDecl $2 [] [] (RecCon [([$4], unbangedType $6)]) $1 }
constrs :: { [RdrNameConDecl] }
{ mkConDecl $2 [] [] (RecCon [([$4], unbangedType $6)]) $1 }
constrs :: { [RdrNameConDecl] }
- : constrs '|' constr { $3 : $1 }
+ : {- empty; a GHC extension -} { [] }
+ | '=' constrs1 { $2 }
+
+constrs1 :: { [RdrNameConDecl] }
+ : constrs1 '|' constr { $3 : $1 }
| constr { [$1] }
constr :: { RdrNameConDecl }
| constr { [$1] }
constr :: { RdrNameConDecl }
\begin{code}
tyConDataCons :: TyCon -> [DataCon]
\begin{code}
tyConDataCons :: TyCon -> [DataCon]
-tyConDataCons tycon = ASSERT2( not (null cons), ppr tycon )
- ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
+tyConDataCons tycon = ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
cons
where
cons = tyConDataConsIfAvailable tycon
cons
where
cons = tyConDataConsIfAvailable tycon