finished except for Tip >< Tip which doesn\'t work

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