.

[clean-tests.git] / gengen / Data / GenType.icl

diff --git a/gengen/Data/GenType.icl b/gengen/Data/GenType.icl
index cb1296c..37f6df5 100644 (file)
--- a/gengen/Data/GenType.icl
+++ b/gengen/Data/GenType.icl
@@ -263,19 +263,22 @@ typeName (TyNewType i _ _) = i.gtd_name
 typeName (TyObject i _) = i.gtd_name
 typeName (TyRecord i _) = i.grd_name
 
-typeGenType :: Type -> GenType
-typeGenType (TyBasic a) = GenTypeCons $ toString a
-typeGenType (TyRef a) = GenTypeCons $ toString a
-typeGenType (TyArrow l r) = GenTypeArrow (typeGenType l) (typeGenType r)
-typeGenType (TyArray s a) = GenTypeApp (GenTypeCons (toString s)) (typeGenType a)
-typeGenType (TyUList s a) = GenTypeApp (GenTypeCons (toString s)) (typeGenType a)
-typeGenType (TyUMaybe a) = GenTypeApp (GenTypeCons "_#Maybe") (typeGenType a)
+typeGenType :: Type -> [GenType]
+typeGenType (TyBasic a) = [GenTypeCons $ toString a]
+typeGenType (TyRef a) = [GenTypeCons $ toString a]
+typeGenType (TyArrow l r) = GenTypeArrow <$> typeGenType l <*> typeGenType r
+typeGenType (TyArray s a) = GenTypeApp (GenTypeCons (toString s)) <$> typeGenType a
+typeGenType (TyUList s a) = [GenTypeCons "_#Nil":GenTypeApp (GenTypeCons (toString s)) <$> typeGenType a]
+typeGenType (TyUMaybe a) = [GenTypeCons "_#Nothing":GenTypeApp (GenTypeCons "_#Just") <$> typeGenType a]
 typeGenType (TyNewType _ _ a) = abort "typeGenType for newtypes not yet implemented\n"
-typeGenType (TyRecord i _) = i.grd_type
-typeGenType (TyObject i _) = gent i.gtd_arity (GenTypeCons i.gtd_name)
-where
-       gent 0 t = t
-       gent n t = gent (dec n) (GenTypeApp t (GenTypeVar n))
+typeGenType (TyRecord i _) = [i.grd_type]
+typeGenType (TyObject _ fs) = [c.gcd_type\\(c, _)<-fs]
+
+genTypeKind :: GenType -> Kind
+genTypeKind (GenTypeCons _) = KStar
+genTypeKind (GenTypeVar _) = KStar
+genTypeKind (GenTypeArrow l r) = undef
+genTypeKind (GenTypeApp l r) = undef
 
 instance isBuiltin String
 where