rose now works
authorMart Lubbers <mart@martlubbers.net>
Mon, 31 Aug 2015 18:06:42 +0000 (20:06 +0200)
committerMart Lubbers <mart@martlubbers.net>
Mon, 31 Aug 2015 18:06:42 +0000 (20:06 +0200)
a1/mart/skeleton1.icl

index bcb57fe..18dac9a 100644 (file)
@@ -51,6 +51,10 @@ instance >< Bool where               // False is smaller than True
        (><) _     _     = Equal\r
 \r
 /**************** End Prelude *************************/\r
+isEqual :: Ordering -> Bool\r
+isEqual Equal = True\r
+isEqual _ = False\r
+\r
 // 1. Ordering by overloading\r
 instance >< Color where\r
        (><) Red Red = Equal\r
@@ -61,35 +65,32 @@ instance >< Color where
        (><) Blue Blue = Equal\r
        (><) _ _ = Smaller\r
 \r
-instance >< (Tree a) | >< a & == a where\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
-       | x == y = case ltx >< lty of\r
-               Equal = rtx >< rty\r
-               otherwise = ltx >< lty\r
-       | otherwise = x >< y\r
-\r
-instance >< (Rose a) | >< a & == a where\r
-       (><) (Rose _ _) (Rose _ []) = Bigger\r
-       (><) (Rose _ []) (Rose _ _) = Smaller\r
-       (><) (Rose x xs) (Rose y ys)\r
-       | x == y = xs >< ys\r
+       | isEqual (x >< y)\r
+               | isEqual (ltx >< lty) = rtx >< rty\r
+               | otherwise = ltx >< lty\r
        | otherwise = x >< y\r
 \r
-instance >< [a] | Ord a & == a where\r
+instance >< [a] | >< a where\r
        (><) [] [] = Equal\r
        (><) [] _ = Smaller\r
        (><) _ [] = Bigger\r
        (><) [x:xs] [y:ys]\r
-       | x == y = xs >< ys\r
-       | x < y = Smaller\r
-       | otherwise = Bigger\r
+       | isEqual (x >< y) = xs >< ys\r
+       | otherwise = x >< y\r
+\r
+instance >< (Rose a) | >< a where\r
+       (><) (Rose x xs) (Rose y ys)\r
+       | isEqual (x >< y) = xs >< ys\r
+       | otherwise = x >< y\r
 \r
-instance >< (a, b) | >< a & >< b & == a where\r
+instance >< (a, b) | >< a & >< b where\r
        (><) (xa, xb) (ya, yb)\r
-       | xa == ya = xb >< yb\r
+       | isEqual (xa >< ya) = xb >< yb\r
        | otherwise = xa >< ya\r
 \r
 //2. Generic representation\r