From: Mart Lubbers <mart@martlubbers.net>
Date: Tue, 22 Sep 2015 19:03:53 +0000 (+0200)
Subject: working excpt map on tuple
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=2453111bc8911511f50aaebbcfa098a1f1f42239;p=ap2015.git

working excpt map on tuple
---

diff --git a/a3/mart/skeleton3a.icl b/a3/mart/skeleton3a.icl
index 3b2c1fd..709c60c 100644
--- a/a3/mart/skeleton3a.icl
+++ b/a3/mart/skeleton3a.icl
@@ -1,28 +1,24 @@
 module skeleton3a
 
 /*
-	Advanced Programming.
-	Skeleton for exercise 3.1 and 3.2.
-	To be used in a project with the environment Everything, 
-	or StdEnv with an import of StdMaybe from StdLib
+ Advanced Programming.
+ Skeleton for exercise 3.1 and 3.2.
+ To be used in a project with the environment Everything, 
+ or StdEnv with an import of StdMaybe from StdLib
 
-	Pieter Koopman, pieter@cs.ru.nl
+ Pieter Koopman, pieter@cs.ru.nl
 */
 
 import StdEnv, StdMaybe
 
 /************* showing *******************/
 
-class show_0 a where show_0 :: a [String] -> [String]
+class show_0 t where show_0 :: t [String] -> [String]
 
-instance show_0 Int  where show_0 i    c = [IntTag :toString i:c]
-instance show_0 Bool where show_0 b    c = [BoolTag:toString b:c]
-instance show_0 UNIT where show_0 unit c = [UNITTag:c]
+instance show_0 Int where show_0 i c = [toString i:c]
+instance show_0 Bool where show_0 b c = [toString b:c]
 
-IntTag	:== "Int"
-BoolTag	:== "Bool"
-UNITTag	:== "UNIT"
-PAIRTag	:== "PAIR"
+instance show_0 UNIT where show_0 _ c = c
 
 show :: a -> [String] | show_0 a
 show a = show_0 a []
@@ -31,143 +27,230 @@ show a = show_0 a []
 
 :: Result a :== Maybe (a,[String])
 
-class parse0 a :: [String] -> Result a
+class parse0 t :: [String] -> Result t
 
-instance parse0 Int
-where
-	parse0 [IntTag,i:r] = Just (toInt i, r)
+instance parse0 Int where
+	parse0 [i:r] = Just (toInt i, r)
 	parse0 r = Nothing
-instance parse0 Bool
-where
-	parse0 [BoolTag,b:r] = Just (b=="True", r)
-	parse0 r = Nothing
-instance parse0 UNIT
-where
-	parse0 [UNITTag:r] = Just (UNIT, r)
+
+instance parse0 Bool where
+	parse0 [b:r] = Just (b == "True", r)
 	parse0 r = Nothing
 
+instance parse0 UNIT where
+	parse0 r = Just (UNIT, r)
+
 /**************** Example Types and conversions *************************/
 
-:: T		= C
-:: Color	= Red | Yellow | Blue
-:: Tree a	= Tip | Bin a (Tree a) (Tree a)
+:: T = C
+:: Color = Red | Yellow | Blue
+:: Tree a = Tip | Bin a (Tree a) (Tree a)
 
-//	Binary sums and products (in generic prelude)
-:: UNIT			= UNIT
-:: PAIR   a b	= PAIR a b
-:: EITHER a b	= LEFT a | RIGHT b
-:: CONS   a		= CONS String a
+// Binary sums and products (in generic prelude)
+:: UNIT = UNIT
+:: PAIR a b = PAIR a b
+:: EITHER a b = LEFT a | RIGHT b
+:: CONS a = CONS String a
 
-//	Generic type representations
-:: TG		:== CONS UNIT
-:: ColorG	:== EITHER (EITHER (CONS UNIT) (CONS UNIT)) (CONS UNIT)
-:: ListG a	:== EITHER (CONS UNIT) (CONS (PAIR a [a]))
-:: TreeG a	:== EITHER (CONS UNIT) (CONS (PAIR a (PAIR (Tree a) (Tree a))))
-:: TupG a b	:== CONS (PAIR a b)
+// Generic type representations
+:: TG :== CONS UNIT
+:: ColorG :== EITHER (EITHER (CONS UNIT) (CONS UNIT)) (CONS UNIT)
+:: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
+:: TreeG a :== EITHER (CONS UNIT) (CONS (PAIR a (PAIR (Tree a) (Tree a))))
+:: TupG a b :== CONS (PAIR a b)
 
 // Conversions
 
-fromT :: T									-> TG
-fromT c										= CONS "C" UNIT
+fromT :: T -> TG
+fromT c = CONS "C" UNIT
 
-fromColor :: Color 							-> ColorG
-fromColor Red								= LEFT (LEFT  (CONS "Red"    UNIT))
-fromColor Yellow							= LEFT (RIGHT (CONS "Yellow" UNIT))
-fromColor Blue								=       RIGHT (CONS "Blue"   UNIT)
+fromColor :: Color  -> ColorG
+fromColor Red = LEFT (LEFT (CONS "Red" UNIT))
+fromColor Yellow = LEFT (RIGHT (CONS "Yellow" UNIT))
+fromColor Blue = RIGHT (CONS "Blue" UNIT)
 
-fromList :: [a]								-> ListG a
-fromList []									= LEFT  (CONS "Nil"  UNIT)
-fromList [a:as]								= RIGHT (CONS "Cons" (PAIR a as))
+fromList :: [a] -> ListG a
+fromList [] = LEFT(CONS "Nil" UNIT)
+fromList [a:as] = RIGHT (CONS "Cons" (PAIR a as))
 
-fromTree :: (Tree a)						-> TreeG a
-fromTree Tip								= LEFT  (CONS "Tip" UNIT)
-fromTree (Bin a l r)						= RIGHT (CONS "Bin" (PAIR a (PAIR l r)))
+fromTree :: (Tree a) -> TreeG a
+fromTree Tip = LEFT(CONS "Tip" UNIT)
+fromTree (Bin a l r) = RIGHT (CONS "Bin" (PAIR a (PAIR l r)))
 
-fromTup :: (a,b)							-> TupG a b
-fromTup (a,b)								= CONS "Tuple2" (PAIR a b)
+fromTup :: (a,b) -> TupG a b
+fromTup (a,b) = CONS "Tuple2" (PAIR a b)
 
-toT :: TG									-> T
-toT (CONS _ UNIT)							= C
+toT :: TG -> T
+toT (CONS _ UNIT) = C
 
-toColor :: ColorG							-> Color
-toColor (LEFT (LEFT  (CONS _ UNIT)))		= Red
-toColor (LEFT (RIGHT (CONS _ UNIT)))		= Yellow
-toColor       (RIGHT (CONS _ UNIT))			= Blue
+toColor :: ColorG -> Color
+toColor (LEFT (LEFT(CONS _ UNIT))) = Red
+toColor (LEFT (RIGHT (CONS _ UNIT))) = Yellow
+toColor (RIGHT (CONS _ UNIT)) = Blue
 
-toList :: (ListG a)							-> [a]
-toList (LEFT  (CONS s UNIT))        		= []
-toList (RIGHT (CONS s (PAIR a as)))		 	= [a:as]
+toList :: (ListG a) -> [a]
+toList (LEFT (CONS s UNIT)) = []
+toList (RIGHT (CONS s (PAIR a as))) = [a:as]
 
-toTree :: (TreeG a)							-> Tree a
-toTree (LEFT  (CONS s UNIT))                = Tip
+toTree :: (TreeG a) -> Tree a
+toTree (LEFT (CONS s UNIT))= Tip
 toTree (RIGHT (CONS s (PAIR a (PAIR l r)))) = Bin a l r
 
-toTup :: (TupG a b)							-> (a,b)
-toTup (CONS s (PAIR a b))					= (a,b)
+toTup :: (TupG a b) -> (a,b)
+toTup (CONS s (PAIR a b)) = (a,b)
 
 /**************** to test if parse and show work properly *************************/
 
 test :: t -> Bool | eq0, show_0, parse0 t
-test x
-	= case parse0 (show x) of
-		Just (y,[])	= eq0 x y
-		_			= False
+test x = case parse0 (show x) of
+	Just (y,[]) = eq0 x y
+	_ = False
 
 /**************** equality with a class for each kind *************************/
 
-class eq0 t ::                              t       t      -> Bool
-class eq1 t :: (a a -> Bool)               (t a)   (t a)   -> Bool
+class eq0 t ::t t-> Bool
+class eq1 t :: (a a -> Bool) (t a) (t a) -> Bool
 class eq2 t :: (a a -> Bool) (b b -> Bool) (t a b) (t a b) -> Bool
 
-instance eq0 UNIT			where eq0 _ _                       = True
-instance eq0 Int			where eq0 n m                       = n == m
+instance eq0 UNIT where eq0 _ _ = True
+instance eq0 Int where eq0 n m = n == m
 
-instance eq1 CONS			where eq1 f   (CONS s x) (CONS t y) = s == t && f x y
+instance eq1 CONS where eq1 f (CONS s x) (CONS t y) = s == t && f x y
 
-instance eq2 PAIR			where eq2 f g (PAIR a b) (PAIR x y) = f a x && g b y
-instance eq2 EITHER			where eq2 f g (LEFT  x)  (LEFT  y)  = f x y
-							      eq2 f g (RIGHT x)  (RIGHT y)  = g x y
-							      eq2 f g _          _          = False
+instance eq2 PAIR where eq2 f g (PAIR a b) (PAIR x y) = f a x && g b y
+instance eq2 EITHER where
+	eq2 f g (LEFT x) (LEFT y)= f x y
+	eq2 f g (RIGHT x) (RIGHT y)= g x y
+	eq2 f g _ _ = False
 
-instance eq0 [a] | eq0 a	where eq0   l m = eq1 eq0 l m
-instance eq1 []				where eq1 f l m = eq2 (eq1 eq0) (eq1 (eq2 f (eq1 f))) (fromList l) (fromList m)
+instance eq0 [a] | eq0 a where eq0 l m = eq1 eq0 l m
+instance eq1 [] where eq1 f l m = eq2 (eq1 eq0) (eq1 (eq2 f (eq1 f))) (fromList l) (fromList m)
 
 /**************** map *************************/
 
-class map0 t ::                    t      -> t
-class map1 t :: (a -> b)          (t a)   -> t b
+class map0 t :: t -> t
+class map1 t :: (a -> b) (t a) -> t b
 class map2 t :: (a -> b) (c -> d) (t a c) -> t b d 
 
-instance map0 Int			where map0 i              = i
-instance map0 UNIT			where map0 UNIT           = UNIT
+instance map0 Int where map0 i = i
+instance map0 UNIT where map0 UNIT = UNIT
 
-instance map1 CONS			where map1 f   (CONS n x) = CONS n (f x)
+instance map1 CONS where map1 f (CONS n x) = CONS n (f x)
 
-instance map2 PAIR			where map2 f g (PAIR x y) = PAIR  (f x) (g y)
-instance map2 EITHER		where map2 f g (LEFT  x)  = LEFT  (f x)
-							      map2 f g (RIGHT y)  = RIGHT (g y)
+instance map2 PAIR where map2 f g (PAIR x y) = PAIR (f x) (g y)
+instance map2 EITHER where
+	map2 f g (LEFT x) = LEFT (f x)
+	map2 f g (RIGHT y)= RIGHT (g y)
 
 /**************** End Prelude *************************/
 
 /**************** please add all new code below this line *************************/
-
-instance eq0 Color		where eq0  c1 c2 = False		// TO BE IMPROVED
-instance ==  Color		where (==) c1 c2 = eq0 c1 c2	// just to use the well-known notation...
-instance show_0 Color	where show_0 _ 	   c = c		// TO BE IMPROVED
-instance parse0 Color	where parse0 _       = Nothing	// TO BE IMPROVED
-
-instance map1 []	where map1 f l = map f l			// TO BE IMPROVED, use generic version
-
-// some initial tests, please extend
-Start
- =	[ and [ test i \\ i <- [-25 .. 25]]
-	, and [ c == toColor (fromColor c) \\ c <- [Red, Yellow, Blue]]
-	, and [ test c \\ c <- [Red,Yellow,Blue]]
-//	, test [1 .. 3]
-//	, test [(a,b) \\ a <- [1 .. 2], b <- [5 .. 7]]
-//	etc.
-	// maps
-	, map1 ((+) 1) [0 .. 5] == [1 .. 6]
-	]
-
-aTree = Bin 2 Tip (Bin 4 Tip Tip)
+//Show stuff
+class show_1 t where show_1 :: (a [String] -> [String]) (t a) [String] -> [String]
+class show_2 t where show_2 :: (a [String] -> [String]) (b [String] -> [String]) (t a b) [String] -> [String]
+
+instance show_1 CONS where
+	show_1 f (CONS s x) c = [s:f x c]
+instance show_2 PAIR where
+	show_2 f1 f2 (PAIR x1 x2) c = f1 x1 (f2 x2 c)
+instance show_2 EITHER where
+	show_2 f1 f2 (LEFT x1) c = f1 x1 c
+	show_2 f1 f2 (RIGHT x2) c = f2 x2 c
+
+instance show_0 Color where
+	show_0 x c = show_2 (show_2 (show_1 show_0) (show_1 show_0)) (show_1 show_0) (fromColor x) c
+
+instance show_1 Tree where
+	show_1 f x c = show_2 (show_1 show_0) (show_1 (show_2 f (show_2 (show_1 f) (show_1 f)))) (fromTree x) c
+instance show_0 (Tree a) | show_0 a where
+	show_0 x c = show_1 show_0 x c
+
+instance show_1 [] where
+	show_1 f x c = show_2 (show_1 show_0) (show_1 (show_2 f (show_1 f))) (fromList x) c
+instance show_0 [a] | show_0 a where
+	show_0 x c = show_1 show_0 x c
+
+instance show_0 (a, b) | show_0 a & show_0 b where
+	show_0 x c = show_1 (show_2 show_0 show_0) (fromTup x) c
+
+instance show_0 T where
+	show_0 x c = show_1 show_0 (fromT x) c
+
+//Parsing stuff
+class parse1 t :: ([String] -> Result a) [String] -> Result (t a)
+class parse2 t :: ([String] -> Result a) ([String] -> Result b) [String] -> Result (t a b)
+
+instance parse1 CONS where
+	parse1 f [s:r] = case f r of
+		Just (x, r) = Just (CONS s x, r)
+		_ = Nothing
+	parse1 _ _ = Nothing
+
+instance parse2 PAIR where
+	parse2 f1 f2 r = case f1 r of
+		Just (x1, r) = case f2 r of
+			Just (x2, r) = Just (PAIR x1 x2, r)
+			_ = Nothing
+		_ = Nothing
+
+instance parse2 EITHER where
+	parse2 f1 f2 r = case f2 r of
+		Just (x, r) = Just (RIGHT x, r)
+		_ = case f1 r of
+			Just (x, r) = Just (LEFT x, r)
+			_ = Nothing
+
+instance parse0 Color where
+	parse0 r = case parse2 (parse2 (parse1 parse0) (parse1 parse0)) (parse1 parse0) r of
+		Just (x, r) = Just (toColor x, r)
+		_ = Nothing
+
+instance parse1 Tree where
+	parse1 f r = case parse2 (parse1 parse0) (parse1 (parse2 f (parse2 (parse1 f) (parse1 f)))) r of
+		Just (x, r) = Just (toTree x, r)
+		_ = Nothing
+instance parse0 (Tree a) | parse0 a where
+	parse0 r = parse1 parse0 r
+
+instance parse1 [] where
+	parse1 f r = case parse2 (parse1 parse0) (parse1 (parse2 f (parse1 f))) r of
+		Just (x, r) = Just (toList x, r)
+		_ = Nothing
+instance parse0 [a] | parse0 a where
+	parse0 r = parse1 parse0 r
+
+instance parse0 (a, b) | parse0 a & parse0 b where
+	parse0 r = case parse1 (parse2 parse0 parse0) r of
+		Just (x, r) = Just (toTup x, r)
+		_ = Nothing
+
+instance parse0 T where
+	parse0 r = case parse1 parse0 r of
+		Just (x, r) = Just (toT x, r)
+		_ = Nothing
+
+instance eq0 Color where 
+	eq0 c1 c2 = eq2 (eq2 (eq1 eq0) (eq1 eq0)) (eq1 eq0) (fromColor c1) (fromColor c2)
+instance == Color where 
+	(==) c1 c2 = eq0 c1 c2
+
+instance map1 [] where
+	map1 f l = toList (map2 (map1 map0) (map1 (map2 f (map1 f))) (fromList l))
+
+instance map1 Tree where
+	map1 f t = toTree (map2 (map1 map0) (map1 (map2 f (map2 (map1 f) (map1 f)))) (fromTree t))
+
+//instance map2 (a, b) | map1 a & map1 a where
+//	map2 f1 f2 t = toTup (map1 (map2 f1 f2) (fromTup t))
+
+Start = (
+	map1 fac aTree,
+	map1 fac aList,
+	//map2 fac fac (aList, aTree),
+	map1 (\x.(x, fac x)) aList
+	)
+	where
+		fac 1 = 1
+		fac n = n * (fac (n-1))
+		aTree = Bin 2 Tip (Bin 4 Tip Tip)
+		aList = [1..10]
diff --git a/a3/mart/skeleton3a_wt.icl b/a3/mart/skeleton3a_wt.icl
new file mode 100644
index 0000000..2e893ec
--- /dev/null
+++ b/a3/mart/skeleton3a_wt.icl
@@ -0,0 +1,217 @@
+module skeleton3a
+
+/*
+ Advanced Programming.
+ Skeleton for exercise 3.1 and 3.2.
+ To be used in a project with the environment Everything, 
+ or StdEnv with an import of StdMaybe from StdLib
+
+ Pieter Koopman, pieter@cs.ru.nl
+*/
+
+import StdEnv, StdMaybe
+
+/************* showing *******************/
+
+class show_0 t where show_0 :: t [String] -> [String]
+class show_1 t where show_1 :: (a [String] -> [String]) (t a) [String] -> [String]
+class show_2 t where show_2 :: (a [String] -> [String]) (b [String] -> [String]) (t a b) [String] -> [String]
+
+instance show_0 Int where show_0 i c = [IntTag :toString i:c]
+instance show_0 Bool where show_0 b c = [BoolTag:toString b:c]
+
+instance show_0 UNIT where show_0 unit c = [UNITTag:c]
+instance show_1 CONS where
+	show_1 f (CONS s x) c = [CONSTag,s:f x c]
+instance show_2 PAIR where
+	show_2 f1 f2 (PAIR x1 x2) c = [PAIRTag:f1 x1 (f2 x2 c)]
+instance show_2 EITHER where
+	show_2 f1 f2 (LEFT x1) c = [LEFTTag:f1 x1 c]
+	show_2 f1 f2 (RIGHT x2) c = [RIGHTTag:f2 x2 c]
+
+instance show_0 Color where
+	show_0 x c = show_2 (show_2 (show_1 show_0) (show_1 show_0)) (show_1 show_0) (fromColor x) c
+
+instance show_1 Tree where
+	show_1 f x c = show_2 (show_1 show_0) (show_1 (show_2 f (show_2 (show_1 f) (show_1 f)))) (fromTree x) c
+instance show_0 (Tree a) | show_0 a where
+	show_0 x c = show_1 show_0 x c
+
+instance show_1 [] where
+	show_1 f x c = show_2 (show_1 show_0) (show_1 (show_2 f (show_1 f))) (fromList x) c
+instance show_0 [a] | show_0 a where
+	show_0 x c = show_1 show_0 x c
+
+instance show_0 (a, b) | show_0 a & show_0 b where
+	show_0 x c = show_1 (show_2 show_0 show_0) (fromTup x) c
+
+instance show_0 T where
+	show_0 x c = show_1 show_0 (fromT x) c
+
+IntTag :== "Int"
+BoolTag :== "Bool"
+UNITTag :== "UNIT"
+PAIRTag :== "PAIR"
+LEFTTag :== "LEFT"
+RIGHTTag :== "RIGHT"
+CONSTag :== "CONS"
+
+show :: a -> [String] | show_0 a
+show a = show_0 a []
+
+/**************** parsing *************************/
+
+:: Result a :== Maybe (a,[String])
+
+class parse0 t :: [String] -> Result t
+class parse1 t :: ([String] -> Result a) [String] -> Result (t a)
+class parse2 t :: ([String] -> Result a) ([String] -> Result b) [String] -> Result (t a b)
+
+instance parse0 Int where
+	parse0 [IntTag,i:r] = Just (toInt i, r)
+	parse0 r = Nothing
+
+instance parse0 Bool where
+	parse0 [BoolTag,b:r] = Just (b == "True", r)
+	parse0 r = Nothing
+
+instance parse0 UNIT where
+	parse0 [UNITTag:r] = Just (UNIT, r)
+	parse0 r = Nothing
+
+instance parse1 CONS where
+	parse1 f [CONSTag,s:r] = case f r of
+		Just (x, r) = Just (CONS s x, r)
+		_ = Nothing
+	parse1 _ _ = Nothing
+
+instance parse2 PAIR where
+	parse2 f1 f2 [PAIRTag:r] = case f1 r of
+		Just (x1, r) = case f2 r of
+			Just (x2, r) = Just (PAIR x1 x2, r)
+			_ = Nothing
+		_ = Nothing
+	parse2 _ _ _ = Nothing 
+
+instance parse2 EITHER where
+	parse2 f1 f2 [LEFTTag:r] = case f1 r of
+		Just (x, r) = Just (LEFT x, r)
+		_ = Nothing
+	parse2 f1 f2 [RIGHTTag:r] = case f2 r of
+		Just (x, r) = Just (RIGHT x, r)
+		_ = Nothing
+
+instance parse0 Color where
+	parse0 r = case parse2 (parse2 (parse1 parse0) (parse1 parse0)) (parse1 parse0) r of
+		Just (x, r) = Just (toColor x, r)
+		_ = Nothing
+
+instance parse1 Tree where
+	parse1 f r = case parse2 (parse1 parse0) (parse1 (parse2 f (parse2 (parse1 f) (parse1 f)))) r of
+		Just (x, r) = Just (toTree x, r)
+		_ = Nothing
+instance parse0 (Tree a) | parse0 a where
+	parse0 r = parse1 parse0 r
+
+instance parse1 [] where
+	parse1 f r = case parse2 (parse1 parse0) (parse1 (parse2 f (parse1 f))) r of
+		Just (x, r) = Just (toList x, r)
+		_ = Nothing
+instance parse0 [a] | parse0 a where
+	parse0 r = parse1 parse0 r
+
+instance parse0 (a, b) | parse0 a & parse0 b where
+	parse0 r = case parse1 (parse2 parse0 parse0) r of
+		Just (x, r) = Just (toTup x, r)
+		_ = Nothing
+
+instance parse0 T where
+	parse0 r = case parse1 parse0 r of
+		Just (x, r) = Just (toT x, r)
+		_ = Nothing
+
+/**************** Example Types and conversions *************************/
+
+:: T = C
+:: Color = Red | Yellow | Blue
+:: Tree a = Tip | Bin a (Tree a) (Tree a)
+
+// Binary sums and products (in generic prelude)
+:: UNIT = UNIT
+:: PAIR a b = PAIR a b
+:: EITHER a b = LEFT a | RIGHT b
+:: CONS a = CONS String a
+
+// Generic type representations
+:: TG :== CONS UNIT
+:: ColorG :== EITHER (EITHER (CONS UNIT) (CONS UNIT)) (CONS UNIT)
+:: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
+:: TreeG a :== EITHER (CONS UNIT) (CONS (PAIR a (PAIR (Tree a) (Tree a))))
+:: TupG a b :== CONS (PAIR a b)
+
+// Conversions
+
+fromT :: T -> TG
+fromT c = CONS "C" UNIT
+
+fromColor :: Color  -> ColorG
+fromColor Red = LEFT (LEFT (CONS "Red" UNIT))
+fromColor Yellow = LEFT (RIGHT (CONS "Yellow" UNIT))
+fromColor Blue = RIGHT (CONS "Blue" UNIT)
+
+fromList :: [a] -> ListG a
+fromList [] = LEFT(CONS "Nil" UNIT)
+fromList [a:as] = RIGHT (CONS "Cons" (PAIR a as))
+
+fromTree :: (Tree a) -> TreeG a
+fromTree Tip = LEFT(CONS "Tip" UNIT)
+fromTree (Bin a l r) = RIGHT (CONS "Bin" (PAIR a (PAIR l r)))
+
+fromTup :: (a,b) -> TupG a b
+fromTup (a,b) = CONS "Tuple2" (PAIR a b)
+
+toT :: TG -> T
+toT (CONS _ UNIT) = C
+
+toColor :: ColorG -> Color
+toColor (LEFT (LEFT(CONS _ UNIT))) = Red
+toColor (LEFT (RIGHT (CONS _ UNIT))) = Yellow
+toColor (RIGHT (CONS _ UNIT)) = Blue
+
+toList :: (ListG a) -> [a]
+toList (LEFT (CONS s UNIT)) = []
+toList (RIGHT (CONS s (PAIR a as))) = [a:as]
+
+toTree :: (TreeG a) -> Tree a
+toTree (LEFT (CONS s UNIT))= Tip
+toTree (RIGHT (CONS s (PAIR a (PAIR l r)))) = Bin a l r
+
+toTup :: (TupG a b) -> (a,b)
+toTup (CONS s (PAIR a b)) = (a,b)
+
+/**************** to test if parse and show work properly *************************/
+
+test :: t -> Bool | eq0, show_0, parse0 t
+test x = case parse0 (show x) of
+	Just (y,[]) = eq0 x y
+	_ = False
+
+/**************** equality with a class for each kind *************************/
+
+class eq0 t ::t t-> Bool
+class eq1 t :: (a a -> Bool) (t a) (t a) -> Bool
+class eq2 t :: (a a -> Bool) (b b -> Bool) (t a b) (t a b) -> Bool
+
+instance eq0 UNIT where eq0 _ _ = True
+instance eq0 Int where eq0 n m = n == m
+
+instance eq1 CONS where eq1 f (CONS s x) (CONS t y) = s == t && f x y
+
+instance eq2 PAIR where eq2 f g (PAIR a b) (PAIR x y) = f a x && g b y
+instance eq2 EITHER where
+	eq2 f g (LEFT x) (LEFT y)= f x y
+	eq2 f g (RIGHT x) (RIGHT y)= g x y
+	eq2 f g _ _ = False
+
+instance eq0 [a] | eq0 a where eq0 l m = eq1 eq0 l m
+instance eq1 [] where eq1 f l m = eq2 (eq1 eq0) (eq1 (eq2 f (eq1 f))) (fromList l) (fromList m)