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 // 1. Ordering by overloading
  55 instance >< Color where
  56         (><) Red Red = Equal
  57         (><) Red _ = Bigger
  58         (><) Yellow Yellow = Equal
  59         (><) Yellow Red = Smaller
  60         (><) Yellow Blue = Bigger
  61         (><) Blue Blue = Equal
  62         (><) _ _ = Smaller
  63
  64 instance >< (Tree a) | >< a & == a where
  65         (><) Tip Tip = Equal
  66         (><) (Bin _ _ _) Tip = Bigger
  67         (><) Tip (Bin _ _ _) = Smaller
  68         (><) (Bin x ltx rtx) (Bin y lty rty)
  69         | x == y = case ltx >< lty of
  70                 Equal = rtx >< rty
  71                 otherwise = ltx >< lty
  72         | otherwise = x >< y
  73
  74 instance >< (Rose a) | >< a & == a where
  75         (><) (Rose _ _) (Rose _ []) = Bigger
  76         (><) (Rose _ []) (Rose _ _) = Smaller
  77         (><) (Rose x xs) (Rose y ys)
  78         | x == y = xs >< ys
  79         | otherwise = x >< y
  80
  81 instance >< [a] | Ord a & == a where
  82         (><) [] [] = Equal
  83         (><) [] _ = Smaller
  84         (><) _ [] = Bigger
  85         (><) [x:xs] [y:ys]
  86         | x == y = xs >< ys
  87         | x < y = Smaller
  88         | otherwise = Bigger
  89
  90 instance >< (a, b) | >< a & >< b & == a where
  91         (><) (xa, xb) (ya, yb)
  92         | xa == ya = xb >< yb
  93         | otherwise = xa >< ya
  94
  95 //2. Generic representation
  96 //2.1
  97 :: ColorG       :== EITHER UNIT (EITHER UNIT UNIT)
  98 :: ListG a      :== EITHER UNIT (PAIR a [a])
  99
 100 //2.2
 101 listToGen :: [a] -> ListG a
 102 listToGen [] = LEFT UNIT
 103 listToGen [x:xs] = RIGHT (PAIR x xs)
 104
 105 //2.3.  EITHER (PAIR 1 (PAIR 2 3)) UNIT
 106 //      Nope, it will leave the xs to be so it will be: EITHER (PAIR 1 [2,3])
 107 //2.4.  Nope, not possible since they are basic types and they can't be
 108 //      converted to UNIT, EITHER or PAIR.
 109
 110 //3. Ordering via generic representation
 111 instance >< UNIT where
 112         (><) _ _ = Equal
 113
 114 instance >< (PAIR a b) | >< a & >< b where
 115         (><) (PAIR x1 y1) (PAIR x2 y2) = case x1 >< x2 of
 116                 Equal = y1 >< y2
 117                 otherwise = x1 >< x2
 118
 119 instance >< (EITHER a b) | >< a & >< b where
 120         (><) (LEFT _) (RIGHT _) = Bigger
 121         (><) (RIGHT _) (LEFT _) = Smaller
 122         (><) (RIGHT x) (RIGHT y) = x >< y
 123         (><) (LEFT x) (LEFT y) = x >< y
 124
 125 Start = "Hello World"