X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Generics%2FgCons.icl;h=07365e2724c0528a12eee95f032a4fdfa5acedcd;hb=de76c5f5ac6a0c4291b51d5b2c16e3611b5c99e3;hp=6f0ceb30f670134801ccbf5191c9648e5b7eaf31;hpb=00fec1dc0792381759d7cfbfb55f17996a11f1a4;p=mTask.git

diff --git a/Generics/gCons.icl b/Generics/gCons.icl
index 6f0ceb3..07365e2 100644
--- a/Generics/gCons.icl
+++ b/Generics/gCons.icl
@@ -8,7 +8,14 @@ implementation module Generics.gCons
 */
 
 import StdEnv, StdGeneric, GenBimap, _SystemStrictLists
+import Data.Functor
 import Data.List
+import Data.Maybe
+
+consByName :: String -> Maybe a | conses{|*|}, consName{|*|} a
+consByName a = let cs = conses{|*|}
+	in ((!!) cs) <$> elemIndex a (map consName{|*|} cs)
+	
 
 generic consName a :: a -> String
 consName{|CONS of {gcd_name}|} f x = gcd_name
@@ -22,14 +29,46 @@ consName{|FIELD|}  f   (FIELD x)  = f x
 consName{|Int|}        i = toString i
 consName{|Bool|}       b = toString b
 consName{|Char|}       c = toString c
+consName{|Real|}       r = toString r
 consName{|String|}     s = s
 consName{|[]|} _ _ = "[]"
+consName{|[!]|} _ _ = "[!]"
+consName{|[ !]|} _ _ = "[ !]"
+consName{|[!!]|} _ _ = "[!!]"
+consName{|{}|} _ _ = "{}"
+consName{|{!}|} _ _ = "{!}"
+consName{|(->)|}   f g x = g (x undef)
 consName{|()|} _ = "()"
 consName{|(,)|} _ _ _ = "(,)"
 consName{|(,,)|}  _ _ _ _ = "(,,)"
 consName{|(,,,)|}  _ _ _ _ _ = "(,,,)"
 consName{|(,,,,)|}  _ _ _ _ _ _ = "(,,,,)"
-consName{|(->)|}   f g x = g (x undef)
+consName{|(,,,,,)|}  _ _ _ _ _ _ _ = "(,,,,,)"
+consName{|(,,,,,,)|}  _ _ _ _ _ _ _ _ = "(,,,,,,)"
+consName{|(,,,,,,,)|}  _ _ _ _ _ _ _ _ _ = "(,,,,,,,)"
+consName{|(,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,)"
+consName{|(,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,)"
+consName{|(,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
+consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
 
 generic consIndex a :: a -> Int
 consIndex{|CONS of {gcd_index}|} f x = gcd_index
@@ -38,16 +77,17 @@ consIndex{|PAIR|} f g (PAIR x y) = f x
 consIndex{|EITHER|} f g (LEFT x) = f x
 consIndex{|EITHER|} f g (RIGHT y) = g y
 consIndex{|OBJECT|} f (OBJECT x) = f x
+consIndex{|RECORD|} f (RECORD x) = f x
+consIndex{|FIELD|} f (FIELD x) = f x
 consIndex{|Int|} i = i
 consIndex{|Bool|} b = if b 1 0
 consIndex{|Char|} c = toInt c
+consIndex{|Real|} r = toInt r
 consIndex{|String|} _ = 0
-consIndex{|[]|} _ _ = 0
-consIndex{|()|} _ = 0
-consIndex{|(,)|} _ _ _ = 0
-consIndex{|(,,)|}  _ _ _ _ = 0
-consIndex{|(,,,)|}  _ _ _ _ _ = 0
-consIndex{|(,,,,)|}  _ _ _ _ _ _ = 0
+consIndex{|{}|} _ _ = 0
+consIndex{|{!}|} _ _ = 0
+consIndex{|(->)|} _ _ _ = 0
+derive consIndex [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
 
 generic conses a :: [a]
 conses{|CONS|} f = [CONS (hd f)]
@@ -62,15 +102,26 @@ conses{|Bool|} = [True]
 conses{|Char|} = ['\0']
 conses{|Real|} = [0.0]
 conses{|String|} = [""]
-conses{|[]|} _ = [[ ]]
-conses{|[!]|} _ = [[!]]
-conses{|[ !]|} _ = [[ !]]
-conses{|[!!]|} _ = [[!!]]
-conses{|()|} = [()]
-conses{|(,)|} f g = zip2 f g
-conses{|(,,)|}  f g h = zip3 f g h
-conses{|(,,,)|}  f g h i = zip4 f g h i
-conses{|(,,,,)|}  f g h i j = zip5 f g h i j
 conses{|{}|} _ = [{}]
 conses{|{!}|} _ = [{!}]
 conses{|(->)|} _ _ = [const undef]
+derive conses [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+
+generic consNum a :: a -> Int
+consNum{|CONS of {gcd_arity}|} f x = gcd_arity
+consNum{|UNIT|} _ = 0
+consNum{|PAIR|} f _ (PAIR x y) = f x
+consNum{|EITHER|} f _ (LEFT x) = f x
+consNum{|EITHER|} _ g (RIGHT y) = g y
+consNum{|OBJECT|} f (OBJECT x) = f x
+consNum{|RECORD|} f (RECORD x) = f x
+consNum{|FIELD|} f (FIELD x) = f x
+consNum{|Int|} _ = 0
+consNum{|Bool|} _ = 0
+consNum{|Char|} _ = 0
+consNum{|Real|} _ = 0
+consNum{|String|} _ = 0
+consNum{|{}|} _ _ = 0
+consNum{|{!}|} _ _ = 0
+consNum{|(->)|} _ _ _ = 0
+derive consNum [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)