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

diff --git a/Generics/gCons.icl b/Generics/gCons.icl
index fc4debc..07365e2 100644
--- a/Generics/gCons.icl
+++ b/Generics/gCons.icl
@@ -8,6 +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
@@ -21,9 +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{|(,,,,,)|}  _ _ _ _ _ _ _ = "(,,,,,)"
+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
@@ -32,11 +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
+derive consIndex [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
 
 generic conses a :: [a]
 conses{|CONS|} f = [CONS (hd f)]
@@ -51,11 +102,26 @@ conses{|Bool|} = [True]
 conses{|Char|} = ['\0']
 conses{|Real|} = [0.0]
 conses{|String|} = [""]
-conses{|[]|} _ = [[ ]]
-conses{|[!]|} _ = [[!]]
-conses{|[ !]|} _ = [[ !]]
-conses{|[!!]|} _ = [[!!]]
 conses{|{}|} _ = [{}]
 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 [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)