repositories
/
clean-tests.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
ae3a7c7
)
t
author
Mart Lubbers
<mart@martlubbers.net>
Mon, 6 Jul 2020 08:17:00 +0000
(10:17 +0200)
committer
Mart Lubbers
<mart@martlubbers.net>
Mon, 6 Jul 2020 08:17:00 +0000
(10:17 +0200)
gengen/gen.icl
patch
|
blob
|
history
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
:: GType
= GTyBasic String
| GTyArrow GType GType
- | GTyArray
Bool
GType
+ | GTyArray
ArrayType
GType
| GTyUnit
| GTyEither GType GType
| GTyPair GType 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
| 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]
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]]]
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]]
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
:: 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
| 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 (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
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]
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{|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)
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
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
:: 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)
:: Tr m b= Tr (m Int b)