From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 6 Jul 2020 08:17:00 +0000 (+0200)
Subject: t
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=4461b1a1a3a3e506e9083d12e5f0ad4796629fdc;p=clean-tests.git

t
---

diff --git a/gengen/gen.icl b/gengen/gen.icl
index b344b38..b518d24 100644
--- a/gengen/gen.icl
+++ b/gengen/gen.icl
@@ -26,7 +26,7 @@ reBox x :== box (unBox x)
 :: GType
 	= GTyBasic String
 	| GTyArrow GType GType
-	| GTyArray Bool GType
+	| GTyArray ArrayType GType
 	| GTyUnit
 	| GTyEither GType GType
 	| GTyPair GType GType
@@ -34,15 +34,21 @@ reBox x :== box (unBox x)
 	| GTyField GenericFieldDescriptor GType
 	| GTyObject GenericTypeDefDescriptor GType
 	| GTyRecord GenericRecordDescriptor GType
+:: ArrayType = ATStrict | ATLazy | ATBoxed
 class print a :: a [String] -> [String]
 instance print Int where print s c = [toString s:c]
 instance print Char where print s c = [toString s:c]
 instance print String where print s c = [s:c]
+instance print ArrayType
+where
+	print ATStrict c = ["!":c]
+	print ATBoxed c = ["#":c]
+	print ATLazy c = c
 instance print GType
 where
 	print (GTyBasic s) c = [s:c]
 	print (GTyArrow l r) c = ["((->)":print l [" ":print r [")":c]]]
-	print (GTyArray s a) c = ["(", if s "!" "", "Array ":print a [")":c]]
+	print (GTyArray s a) c = ["{":print s $ print a ["}":c]]
 	print GTyUnit c = ["UNIT":c]
 	print (GTyEither l r) c = ["(EITHER":print l [" ":print r [")":c]]]
 	print (GTyPair l r) c = ["(PAIR ":print l [")":c]]
@@ -54,22 +60,32 @@ where
 :: Type
 	= TyBasic String
 	| TyArrow Type Type
-	| TyArray Bool Type
+	| TyArray ArrayType Type
 	| TyNewType GenericTypeDefDescriptor GenericConsDescriptor Type
 	| TyObject GenericTypeDefDescriptor [(GenericConsDescriptor, [Type])]
 	| TyRecord GenericRecordDescriptor [(GenericFieldDescriptor, Type)]
 instance print Type
 where
-	print (TyBasic s) c = [s:c]
+	print (TyBasic s) c = [case s of
+			"_List"   = "[]"
+			"_!List"  = "[! ]"
+			"_List!"  = "[ !]"
+			"_!List!" = "[!!]"
+			"_#List"  = "[#]"
+			"_#List!" = "[#!]"
+			"_Array"  = "{}"
+			"_!Array" = "{!}"
+			"_#Array" = "{#}"
+			_ = s:c]
 	print (TyArrow l r) c = print l [" -> ":print r c]
-	print (TyArray s a) c = ["{", if s "!" "":print a ["}":c]]
+	print (TyArray s a) c = ["{":print s $ print a ["}":c]]
 	print (TyNewType i j cons) c = pTyVars i.gtd_name i.gtd_arity
 		[": ", j.gcd_name, " ":print (nttype j.gcd_type) c]
 	where nttype (GenTypeArrow l r) = l
 	print (TyRecord i fields) c = pTyVars i.grd_name i.grd_type_arity
 		[" {":isperse ", " (pField (\i c->[i.gfd_name, " :: ":c]) fields i.grd_type) ["}":c]]
 	print (TyObject i conses) c = pTyVars i.gtd_name i.gtd_arity
-		$ [" ":isperse " | " (map pCons conses) c]
+			$ [" ":isperse " | " (map pCons conses) c]
 	where
 		pCons :: (GenericConsDescriptor, [Type]) [String] -> [String]
 		pCons (i, ts) c = n [" ":isperse " " (pField (\_->id) [(i, t)\\t<-ts] i.gcd_type) c]
@@ -152,8 +168,11 @@ type{|Char|} = box $ GTyBasic "Char"
 type{|World|} = box $ GTyBasic "World"
 type{|Dynamic|} = box $ GTyBasic "Dynamic"
 type{|(->)|} l r = box $ GTyArrow (unBox l) (unBox r)
-type{|{}|} a = box $ GTyArray False $ unBox a
-type{|{!}|} a = box $ GTyArray True $ unBox a
+type{|{}|} a = box $ GTyArray ATLazy $ unBox a
+type{|{!}|} a = box $ GTyArray ATStrict $ unBox a
+type{|{#}|} a = box $ GTyArray ATBoxed $ unBox a
+type{|[#]|} a = box $ GTyArray ATBoxed $ unBox a
+type{|[#!]|} a = box $ GTyArray ATBoxed $ unBox a
 
 type{|UNIT|} = box GTyUnit
 type{|EITHER|} l r = box $ GTyEither (unBox l) (unBox r)
@@ -163,10 +182,11 @@ type{|FIELD of gfd|} a = box $ GTyField gfd $ unBox a
 type{|OBJECT of gtd|} a = box $ GTyObject gtd $ unBox a
 type{|RECORD of grd|} a = box $ GTyRecord grd $ unBox a
 
-derive type [], Either, Maybe, T, R, Frac, Tr, (,)
+derive type [], [! ], [ !], [!!], Either, Maybe, T, R, Frac, Tr, (,), (,,), (,,,), (,,,,), (,,,,,)
 
 :: T a =: T2 a
-:: R a = {f1 :: Maybe (R a), f2 :: Bool, f3 :: T a, f4 :: Char -> Dynamic}
+:: R a = {f1 :: Maybe (R a), f2 :: Bool, f3 :: T a, f4 :: Char -> Dynamic,
+	f5 :: [([!Int!], [!Int], [Int!], {!Int}, {R Bool}, {#Char})]/*({!Int}, {#Char}, {R Bool})*/}
 
 :: Tr m b= Tr (m Int b)