t

diff --git a/gengen/gen.icl b/gengen/gen.icl
index b344b38..b518d24 100644 (file)
--- 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)