Commit 0004357c authored by simonpj's avatar simonpj
Browse files

[project @ 2001-06-11 12:21:17 by simonpj]

--------------------------
	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
parent 0a5856f3
...@@ -464,7 +464,7 @@ instance (NamedThing name, Outputable name, Outputable pat) ...@@ -464,7 +464,7 @@ instance (NamedThing name, Outputable name, Outputable pat)
ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon, ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = ncons, tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = ncons,
tcdDerivs = derivings}) 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) (pp_condecls condecls ncons)
derivings derivings
where where
...@@ -490,7 +490,7 @@ pp_decl_head :: Outputable name => HsContext name -> name -> [HsTyVarBndr name] ...@@ -490,7 +490,7 @@ pp_decl_head :: Outputable name => HsContext name -> name -> [HsTyVarBndr name]
pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars] 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 [] 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 pp_tydecl pp_head pp_decl_rhs derivings
= hang pp_head 4 (sep [ = 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 $
Haskell grammar. Haskell grammar.
...@@ -341,10 +341,10 @@ topdecl :: { RdrBinding } ...@@ -341,10 +341,10 @@ topdecl :: { RdrBinding }
-- Instead we just say b is out of scope -- Instead we just say b is out of scope
{ RdrHsDecl (TyClD (TySynonym (fst $3) (snd $3) $5 $1)) } { 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) -> {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
returnP (RdrHsDecl (TyClD 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 | srcloc 'newtype' ctype '=' newconstr deriving
{% checkDataHeader $3 `thenP` \(cs,c,ts) -> {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
...@@ -605,7 +605,11 @@ newconstr :: { RdrNameConDecl } ...@@ -605,7 +605,11 @@ newconstr :: { RdrNameConDecl }
{ mkConDecl $2 [] [] (RecCon [([$4], unbangedType $6)]) $1 } { mkConDecl $2 [] [] (RecCon [([$4], unbangedType $6)]) $1 }
constrs :: { [RdrNameConDecl] } constrs :: { [RdrNameConDecl] }
: constrs '|' constr { $3 : $1 } : {- empty; a GHC extension -} { [] }
| '=' constrs1 { $2 }
constrs1 :: { [RdrNameConDecl] }
: constrs1 '|' constr { $3 : $1 }
| constr { [$1] } | constr { [$1] }
constr :: { RdrNameConDecl } constr :: { RdrNameConDecl }
......
...@@ -414,8 +414,7 @@ isForeignTyCon other = False ...@@ -414,8 +414,7 @@ isForeignTyCon other = False
\begin{code} \begin{code}
tyConDataCons :: TyCon -> [DataCon] tyConDataCons :: TyCon -> [DataCon]
tyConDataCons tycon = ASSERT2( not (null cons), ppr tycon ) tyConDataCons tycon = ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
cons cons
where where
cons = tyConDataConsIfAvailable tycon cons = tyConDataConsIfAvailable tycon
......
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