[project @ 2001-06-11 12:21:17 by simonpj]
authorsimonpj <unknown>
Mon, 11 Jun 2001 12:21:17 +0000 (12:21 +0000)
committersimonpj <unknown>
Mon, 11 Jun 2001 12:21:17 +0000 (12:21 +0000)
--------------------------
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

ghc/compiler/hsSyn/HsDecls.lhs
ghc/compiler/parser/Parser.y
ghc/compiler/types/TyCon.lhs

index fc136d3..28778b7 100644 (file)
@@ -464,7 +464,7 @@ instance (NamedThing name, Outputable name, Outputable pat)
     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
@@ -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_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 [
index e747d2c..872257f 100644 (file)
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$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.
 
@@ -341,10 +341,10 @@ topdecl :: { RdrBinding }
                -- 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
-                     (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) ->
@@ -605,7 +605,11 @@ newconstr :: { 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 }
index b8a139b..015d0b3 100644 (file)
@@ -414,8 +414,7 @@ isForeignTyCon other                                      = False
 
 \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