From: simonpj <unknown>
Date: Fri, 8 Oct 2004 11:36:29 +0000 (+0000)
Subject: [project @ 2004-10-08 11:36:26 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~1519
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=113397e427d102afed56cc0625f3eb096465ad24;p=ghc-hetmet.git

[project @ 2004-10-08 11:36:26 by simonpj]
Fix missing case for algTyConRhs; fixes test ghci011
---

diff --git a/ghc/compiler/iface/IfaceSyn.lhs b/ghc/compiler/iface/IfaceSyn.lhs
index 6a0a1c7..3d3029c 100644
--- a/ghc/compiler/iface/IfaceSyn.lhs
+++ b/ghc/compiler/iface/IfaceSyn.lhs
@@ -53,7 +53,7 @@ import TyCon		( TyCon, ArgVrcs, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCo
 			  isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
 			  isTupleTyCon, tupleTyConBoxity,
 			  tyConHasGenerics, tyConArgVrcs, getSynTyConDefn,
-			  tyConArity, tyConTyVars, algTcRhs, tyConExtName  )
+			  tyConArity, tyConTyVars, algTyConRhs, tyConExtName  )
 import DataCon		( dataConName, dataConSig, dataConFieldLabels, dataConStrictMarks,
 			  dataConTyCon, dataConIsInfix, isVanillaDataCon )
 import Class		( FunDep, DefMeth, classExtraBigSig, classTyCon )
@@ -490,7 +490,7 @@ tyThingToIfaceDecl _ abstract_tcs ext (ATyCon tycon)
   | isAlgTyCon tycon
   = IfaceData {	ifName    = getOccName tycon,
 		ifTyVars  = toIfaceTvBndrs tyvars,
-		ifCons    = ifaceConDecls (algTcRhs tycon),
+		ifCons    = ifaceConDecls (algTyConRhs tycon),
 	  	ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
 		ifVrcs    = tyConArgVrcs tycon,
 		ifGeneric = tyConHasGenerics tycon }
diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs
index 08e47ee..a9d632e 100644
--- a/ghc/compiler/typecheck/TcSplice.lhs
+++ b/ghc/compiler/typecheck/TcSplice.lhs
@@ -45,7 +45,7 @@ import TcRnMonad
 import IfaceEnv		( lookupOrig )
 import Class		( Class, classBigSig )
 import TyCon		( TyCon, AlgTyConRhs(..), tyConTyVars, getSynTyConDefn, 
-			  isSynTyCon, isNewTyCon, tyConDataCons, algTcRhs )
+			  isSynTyCon, isNewTyCon, tyConDataCons, algTyConRhs )
 import DataCon		( DataCon, dataConTyCon, dataConOrigArgTys, dataConStrictMarks, 
 			  dataConName, dataConFieldLabels, dataConWrapId, dataConIsInfix, 
 			  isVanillaDataCon )
@@ -569,7 +569,7 @@ reifyTyCon tc
 	; return (TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
 
 reifyTyCon tc
-  = case algTcRhs tc of
+  = case algTyConRhs tc of
       NewTyCon data_con _ _ 
 	-> do	{ con <- reifyDataCon data_con
 		; return (TH.NewtypeD [] (reifyName tc) (reifyTyVars (tyConTyVars tc))
diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
index 78cf5be..3c7206b 100644
--- a/ghc/compiler/types/TyCon.lhs
+++ b/ghc/compiler/types/TyCon.lhs
@@ -33,7 +33,7 @@ module TyCon(
 	tyConUnique,
 	tyConTyVars,
 	tyConArgVrcs,
-	algTcRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
+	algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
 	tyConFields, tyConSelIds,
 	tyConStupidTheta,
 	tyConArity,
@@ -490,6 +490,11 @@ tyConFields other_tycon		          = []
 
 tyConSelIds :: TyCon -> [Id]
 tyConSelIds tc = [id | (_,_,id) <- tyConFields tc]
+
+algTyConRhs :: TyCon -> AlgTyConRhs
+algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
+algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon (Just []) [con] False
+algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
 \end{code}
 
 \begin{code}