X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FBuildTyCl.lhs;h=c669daf67cb656367f7839a29d6c66ef9b5b82fa;hp=d1118c01286375ae1cca62c81235d0ee599cd1c8;hb=e8a591c1a3dbdeccec2dd2aacccd7435004b0d51;hpb=202ac08f3e2afde0620e889cc81a95b2fd0ad9e1

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index d1118c0..c669daf 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -6,7 +6,8 @@
 module BuildTyCl (
 	buildSynTyCon, buildAlgTyCon, buildDataCon,
 	buildClass,
-	mkAbstractTyConRhs, mkNewTyConRhs, mkDataTyConRhs
+	mkAbstractTyConRhs, mkOpenDataTyConRhs, mkOpenNewTyConRhs,
+	mkNewTyConRhs, mkDataTyConRhs 
     ) where
 
 #include "HsVersions.h"
@@ -26,14 +27,16 @@ import OccName		( mkDataConWrapperOcc, mkDataConWorkerOcc, mkClassTyConOcc,
 			  mkClassDataConOcc, mkSuperDictSelOcc, mkNewTyCoOcc )
 import MkId		( mkDataConIds, mkRecordSelId, mkDictSelId )
 import Class		( mkClass, Class( classTyCon), FunDep, DefMeth(..) )
-import TyCon		( mkSynTyCon, mkAlgTyCon, visibleDataCons, tyConStupidTheta,
-			  tyConDataCons, isNewTyCon, mkClassTyCon, TyCon( tyConTyVars ),
-			  isRecursiveTyCon, tyConArity,
-			  AlgTyConRhs(..), newTyConRhs )
+import TyCon		( mkSynTyCon, mkAlgTyCon, visibleDataCons,
+			  tyConStupidTheta, tyConDataCons, isNewTyCon,
+			  mkClassTyCon, TyCon( tyConTyVars ),
+			  isRecursiveTyCon, tyConArity, AlgTyConRhs(..),
+			  SynTyConRhs(..), newTyConRhs )
 import Type		( mkArrowKinds, liftedTypeKind, typeKind, 
 			  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
-			  splitTyConApp_maybe, splitAppTy_maybe, getTyVar_maybe,
-			  mkPredTys, mkTyVarTys, ThetaType, Type, 
+			  splitTyConApp_maybe, splitAppTy_maybe,
+			  getTyVar_maybe, 
+			  mkPredTys, mkTyVarTys, ThetaType, Type, Kind,
 			  substTyWith, zipTopTvSubst, substTheta, mkForAllTys,
                           mkTyConApp, mkTyVarTy )
 import Coercion         ( mkNewTypeCoercion )
@@ -45,8 +48,13 @@ import List		( nub )
 
 \begin{code}
 ------------------------------------------------------
-buildSynTyCon name tvs rhs_ty
-  = mkSynTyCon name kind tvs rhs_ty
+buildSynTyCon :: Name -> [TyVar] -> SynTyConRhs -> TyCon
+buildSynTyCon name tvs rhs@(OpenSynTyCon rhs_ki)
+  = mkSynTyCon name kind tvs rhs
+  where
+    kind = mkArrowKinds (map tyVarKind tvs) rhs_ki
+buildSynTyCon name tvs rhs@(SynonymTyCon rhs_ty)
+  = mkSynTyCon name kind tvs rhs
   where
     kind = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
 
@@ -72,6 +80,12 @@ buildAlgTyCon tc_name tvs stupid_theta rhs is_rec want_generics gadt_syn
 mkAbstractTyConRhs :: AlgTyConRhs
 mkAbstractTyConRhs = AbstractTyCon
 
+mkOpenDataTyConRhs :: AlgTyConRhs
+mkOpenDataTyConRhs = OpenDataTyCon
+
+mkOpenNewTyConRhs :: AlgTyConRhs
+mkOpenNewTyConRhs = OpenNewTyCon
+
 mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
 mkDataTyConRhs cons
   = DataTyCon { data_cons = cons, is_enum = all isNullarySrcDataCon cons }