a1/mart/skeleton1.icl

   1 module skeleton1
   2 //Charlie Gerhardus (s000000)
   3 //Mart Lubbers (s4109503)
   4
   5 import StdEnv
   6
   7 /**************** Prelude: *******************************/
   8 //      Example types
   9 :: Color        = Red | Yellow | Blue
  10 :: Tree a       = Tip | Bin a (Tree a) (Tree a)
  11 :: Rose a       = Rose a [Rose a]
  12
  13 //      Binary sums and products (in generic prelude)
  14 :: UNIT         = UNIT
  15 :: PAIR   a b   = PAIR a b
  16 :: EITHER a b   = LEFT a | RIGHT b
  17
  18 //      Generic type representations
  19 :: RoseG a      :== PAIR a [Rose a]
  20
  21 // Conversions
  22 fromRose :: (Rose a) -> RoseG a
  23 fromRose (Rose a l)= PAIR a l
  24
  25 // Ordering
  26 :: Ordering = Smaller | Equal | Bigger
  27
  28 class (><) infix 4 a :: !a !a -> Ordering
  29
  30 instance >< Int where           // Standard ordering for Int
  31         (><) x y
  32         | x < y         = Smaller
  33         | x > y         = Bigger
  34         | otherwise     = Equal
  35
  36 instance >< Char where          // Standard ordering for Char
  37         (><) x y
  38         | x < y         = Smaller
  39         | x > y         = Bigger
  40         | otherwise     = Equal
  41
  42 instance >< String where        // Standard lexicographical ordering
  43         (><) x y
  44         | x < y         = Smaller
  45         | x > y         = Bigger
  46         | otherwise     = Equal
  47
  48 instance >< Bool where          // False is smaller than True
  49         (><) False True  = Smaller
  50         (><) True  False = Bigger
  51         (><) _     _     = Equal
  52
  53 /**************** End Prelude *************************/
  54 isEqual :: Ordering -> Bool
  55 isEqual Equal = True
  56 isEqual _ = False
  57
  58 // 1. Ordering by overloading
  59 instance >< Color where
  60         (><) Red Red = Equal
  61         (><) Red _ = Bigger
  62         (><) Yellow Yellow = Equal
  63         (><) Yellow Red = Smaller
  64         (><) Yellow Blue = Bigger
  65         (><) Blue Blue = Equal
  66         (><) _ _ = Smaller
  67
  68 instance >< (Tree a) | >< a where
  69         (><) Tip Tip = Equal
  70         (><) (Bin _ _ _) Tip = Bigger
  71         (><) Tip (Bin _ _ _) = Smaller
  72         (><) (Bin x ltx rtx) (Bin y lty rty)
  73         | isEqual (x >< y)
  74                 | isEqual (ltx >< lty) = rtx >< rty
  75                 | otherwise = ltx >< lty
  76         | otherwise = x >< y
  77
  78 instance >< [a] | >< a where
  79         (><) [] [] = Equal
  80         (><) [] _ = Smaller
  81         (><) _ [] = Bigger
  82         (><) [x:xs] [y:ys]
  83         | isEqual (x >< y) = xs >< ys
  84         | otherwise = x >< y
  85
  86 instance >< (Rose a) | >< a where
  87         (><) (Rose x xs) (Rose y ys)
  88         | isEqual (x >< y) = xs >< ys
  89         | otherwise = x >< y
  90
  91 instance >< (a, b) | >< a & >< b where
  92         (><) (xa, xb) (ya, yb)
  93         | isEqual (xa >< ya) = xb >< yb
  94         | otherwise = xa >< ya
  95
  96 //2. Generic representation
  97 //2.1
  98 :: ColorG       :== EITHER UNIT (EITHER UNIT UNIT)
  99 :: ListG a      :== EITHER UNIT (PAIR a [a])
 100
 101 //2.2
 102 listToGen :: [a] -> ListG a
 103 listToGen [] = LEFT UNIT
 104 listToGen [x:xs] = RIGHT (PAIR x xs)
 105
 106 //2.3.  EITHER (PAIR 1 (PAIR 2 3)) UNIT
 107 //      Nope, it will leave the xs to be so it will be: EITHER (PAIR 1 [2,3])
 108 //2.4.  Nope, not possible since they are basic types and they can't be
 109 //      converted to UNIT, EITHER or PAIR.
 110
 111 //3. Ordering via generic representation
 112 instance >< UNIT where
 113         (><) _ _ = Equal
 114
 115 instance >< (PAIR a b) | >< a & >< b where
 116         (><) (PAIR x1 y1) (PAIR x2 y2) = case x1 >< x2 of
 117                 Equal = y1 >< y2
 118                 otherwise = x1 >< x2
 119
 120 instance >< (EITHER a b) | >< a & >< b where
 121         (><) (LEFT _) (RIGHT _) = Bigger
 122         (><) (RIGHT _) (LEFT _) = Smaller
 123         (><) (RIGHT x) (RIGHT y) = x >< y
 124         (><) (LEFT x) (LEFT y) = x >< y
 125
 126 Start = "Hello World"