From 4db2c92cedd11b90c6cec46c245b3b618f734d49 Mon Sep 17 00:00:00 2001
From: Josef Svenningsson <josef.svenningsson@gmail.com>
Date: Thu, 20 Apr 2006 21:36:22 +0000
Subject: [PATCH] Extcore can now handle data types without constructors
---
compiler/coreSyn/MkExternalCore.lhs | 3 ++-
compiler/parser/ParserCore.y | 8 ++++----
2 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
index 291b16e823e..b4970cca48c 100644
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ b/compiler/coreSyn/MkExternalCore.lhs
@@ -64,7 +64,8 @@ collect_tdefs tcon tdefs
where
tdef | isNewTyCon tcon =
C.Newtype (make_con_qid (tyConName tcon)) (map make_tbind tyvars) repclause
- | null (tyConDataCons tcon) = error "MkExternalCore died: can't handle datatype declarations with no data constructors"
+-- 20060420 GHC handles empty data types just fine. ExtCore should too! jds
+-- | null (tyConDataCons tcon) = error "MkExternalCore died: can't handle datatype declarations with no data constructors"
| otherwise =
C.Data (make_con_qid (tyConName tcon)) (map make_tbind tyvars) (map make_cdef (tyConDataCons tcon))
where repclause | isRecursiveTyCon tcon = Nothing
diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index 3210583f965..7b82ebad22f 100644
--- a/compiler/parser/ParserCore.y
+++ b/compiler/parser/ParserCore.y
@@ -82,7 +82,7 @@ tdefs :: { [TyClDecl RdrName] }
| tdef ';' tdefs {$1:$3}
tdef :: { TyClDecl RdrName }
- : '%data' q_tc_name tv_bndrs '=' '{' cons1 '}'
+ : '%data' q_tc_name tv_bndrs '=' '{' cons '}'
{ mkTyData DataType (noLoc [], noLoc (ifaceExtRdrName $2), map toHsTvBndr $3) Nothing $6 Nothing }
| '%newtype' q_tc_name tv_bndrs trep
{ let tc_rdr = ifaceExtRdrName $2 in
@@ -97,9 +97,9 @@ trep :: { OccName -> [LConDecl RdrName] }
in [noLoc $ ConDecl (noLoc dc_name) Explicit []
(noLoc []) con_info ResTyH98]) }
-cons1 :: { [LConDecl RdrName] }
- : con { [$1] }
- | con ';' cons1 { $1:$3 }
+cons :: { [LConDecl RdrName] }
+ : {- empty -} { [] } -- 20060420 Empty data types allowed. jds
+ | con ';' cons { $1:$3 }
con :: { LConDecl RdrName }
: d_pat_occ attv_bndrs hs_atys
--
GitLab