From 89171334cfd6f34724b7d61a91341f372a8a35cc Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 31 Aug 2015 21:07:25 +0200
Subject: [PATCH] finished except for Tip >< Tip which doesn\'t work

---
 a1/mart/skeleton1.icl | 85 +++++++++++++++++++++++++++++--------------
 1 file changed, 57 insertions(+), 28 deletions(-)

diff --git a/a1/mart/skeleton1.icl b/a1/mart/skeleton1.icl
index 18dac9a..dd17d73 100644
--- a/a1/mart/skeleton1.icl
+++ b/a1/mart/skeleton1.icl
@@ -56,24 +56,22 @@ isEqual Equal = True
 isEqual _ = False
 
 // 1. Ordering by overloading
-instance >< Color where
-	(><) Red Red = Equal
-	(><) Red _ = Bigger
-	(><) Yellow Yellow = Equal
-	(><) Yellow Red = Smaller
-	(><) Yellow Blue = Bigger
-	(><) Blue Blue = Equal
-	(><) _ _ = Smaller
-
-instance >< (Tree a) | >< a where
-	(><) Tip Tip = Equal
-	(><) (Bin _ _ _) Tip = Bigger
-	(><) Tip (Bin _ _ _) = Smaller
-	(><) (Bin x ltx rtx) (Bin y lty rty)
-	| isEqual (x >< y)
-		| isEqual (ltx >< lty) = rtx >< rty
-		| otherwise = ltx >< lty
-	| otherwise = x >< y
+//instance >< Color where
+//	(><) x y = (toInt x) >< (toInt y)
+//		where
+//			toInt Red = 3
+//			toInt Yellow = 2
+//			toInt Blue = 1
+
+//instance >< (Tree a) | >< a where
+//	(><) Tip Tip = Equal
+//	(><) (Bin _ _ _) Tip = Bigger
+//	(><) Tip (Bin _ _ _) = Smaller
+//	(><) (Bin x ltx rtx) (Bin y lty rty)
+//	| isEqual (x >< y)
+//		| isEqual (ltx >< lty) = rtx >< rty
+//		| otherwise = ltx >< lty
+//	| otherwise = x >< y
 
 instance >< [a] | >< a where
 	(><) [] [] = Equal
@@ -88,15 +86,17 @@ instance >< (Rose a) | >< a where
 	| isEqual (x >< y) = xs >< ys
 	| otherwise = x >< y
 
-instance >< (a, b) | >< a & >< b where
-	(><) (xa, xb) (ya, yb)
-	| isEqual (xa >< ya) = xb >< yb
-	| otherwise = xa >< ya
+//instance >< (a, b) | >< a & >< b where
+//	(><) (xa, xb) (ya, yb)
+//	| isEqual (xa >< ya) = xb >< yb
+//	| otherwise = xa >< ya
 
 //2. Generic representation
 //2.1
 :: ColorG	:== EITHER UNIT (EITHER UNIT UNIT)
 :: ListG a	:== EITHER UNIT (PAIR a [a])
+:: TupleG a b	:== PAIR a b
+:: TreeG a	:== EITHER UNIT (PAIR a (PAIR (Tree a) (Tree a)))
 
 //2.2
 listToGen :: [a] -> ListG a
@@ -109,18 +109,47 @@ listToGen [x:xs] = RIGHT (PAIR x xs)
 //	converted to UNIT, EITHER or PAIR.
 
 //3. Ordering via generic representation
+//3.1
 instance >< UNIT where
 	(><) _ _ = Equal
 
 instance >< (PAIR a b) | >< a & >< b where
-	(><) (PAIR x1 y1) (PAIR x2 y2) = case x1 >< x2 of
-		Equal = y1 >< y2
-		otherwise = x1 >< x2
+	(><) (PAIR x1 y1) (PAIR x2 y2)
+	| isEqual (x1 >< x2) = y1 >< y2
+	| otherwise = x1 >< x2
 
 instance >< (EITHER a b) | >< a & >< b where
-	(><) (LEFT _) (RIGHT _) = Bigger
-	(><) (RIGHT _) (LEFT _) = Smaller
+	(><) (LEFT _) (RIGHT _) = Smaller
+	(><) (RIGHT _) (LEFT _) = Bigger
 	(><) (RIGHT x) (RIGHT y) = x >< y
 	(><) (LEFT x) (LEFT y) = x >< y
 
-Start = "Hello World"
+instance >< Color where
+	(><) a b = colorToGen a >< colorToGen b
+
+instance >< (a, b) | >< a & >< b where
+	(><) a b = tupleToGen a >< tupleToGen b
+
+instance >< (Tree a) | >< a where
+	(><) a b = treeToGen a >< treeToGen b
+
+colorToGen :: Color -> ColorG
+colorToGen Blue = LEFT UNIT
+colorToGen Yellow = RIGHT (LEFT UNIT)
+colorToGen Red = RIGHT (RIGHT UNIT)
+
+tupleToGen :: (a, b) -> TupleG a b
+tupleToGen (x, y) = PAIR x y
+
+treeToGen :: (Tree a) -> TreeG a
+treeToGen Tip = LEFT UNIT
+treeToGen (Bin x xr xl) = RIGHT (PAIR x (PAIR xr xl))
+
+//3.2.	Yes
+//3.3.	Less defining and easier overloading
+//3.4.	Overhead, the compiler has to translate on and on
+
+Start = [Red >< Yellow, Blue >< Yellow, Blue >< Blue,
+	(Bin 1 Tip Tip) >< Tip,
+	(Bin 1 Tip Tip) >< (Bin 1 Tip Tip),
+	Tip >< (Bin 1 Tip Tip) ]
-- 
2.20.1