a3/mart/skeleton3a.icl

   1 module skeleton3a
   2
   3 /*
   4         Advanced Programming.
   5         Skeleton for exercise 3.1 and 3.2.
   6         To be used in a project with the environment Everything,
   7         or StdEnv with an import of StdMaybe from StdLib
   8
   9         Pieter Koopman, pieter@cs.ru.nl
  10 */
  11
  12 import StdEnv, StdMaybe
  13
  14 /************* showing *******************/
  15
  16 class show_0 a where show_0 :: a [String] -> [String]
  17
  18 instance show_0 Int  where show_0 i    c = [IntTag :toString i:c]
  19 instance show_0 Bool where show_0 b    c = [BoolTag:toString b:c]
  20 instance show_0 UNIT where show_0 unit c = [UNITTag:c]
  21
  22 IntTag  :== "Int"
  23 BoolTag :== "Bool"
  24 UNITTag :== "UNIT"
  25 PAIRTag :== "PAIR"
  26
  27 show :: a -> [String] | show_0 a
  28 show a = show_0 a []
  29
  30 /**************** parsing *************************/
  31
  32 :: Result a :== Maybe (a,[String])
  33
  34 class parse0 a :: [String] -> Result a
  35
  36 instance parse0 Int
  37 where
  38         parse0 [IntTag,i:r] = Just (toInt i, r)
  39         parse0 r = Nothing
  40 instance parse0 Bool
  41 where
  42         parse0 [BoolTag,b:r] = Just (b=="True", r)
  43         parse0 r = Nothing
  44 instance parse0 UNIT
  45 where
  46         parse0 [UNITTag:r] = Just (UNIT, r)
  47         parse0 r = Nothing
  48
  49 /**************** Example Types and conversions *************************/
  50
  51 :: T            = C
  52 :: Color        = Red | Yellow | Blue
  53 :: Tree a       = Tip | Bin a (Tree a) (Tree a)
  54
  55 //      Binary sums and products (in generic prelude)
  56 :: UNIT                 = UNIT
  57 :: PAIR   a b   = PAIR a b
  58 :: EITHER a b   = LEFT a | RIGHT b
  59 :: CONS   a             = CONS String a
  60
  61 //      Generic type representations
  62 :: TG           :== CONS UNIT
  63 :: ColorG       :== EITHER (EITHER (CONS UNIT) (CONS UNIT)) (CONS UNIT)
  64 :: ListG a      :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
  65 :: TreeG a      :== EITHER (CONS UNIT) (CONS (PAIR a (PAIR (Tree a) (Tree a))))
  66 :: TupG a b     :== CONS (PAIR a b)
  67
  68 // Conversions
  69
  70 fromT :: T                                                                      -> TG
  71 fromT c                                                                         = CONS "C" UNIT
  72
  73 fromColor :: Color                                                      -> ColorG
  74 fromColor Red                                                           = LEFT (LEFT  (CONS "Red"    UNIT))
  75 fromColor Yellow                                                        = LEFT (RIGHT (CONS "Yellow" UNIT))
  76 fromColor Blue                                                          =       RIGHT (CONS "Blue"   UNIT)
  77
  78 fromList :: [a]                                                         -> ListG a
  79 fromList []                                                                     = LEFT  (CONS "Nil"  UNIT)
  80 fromList [a:as]                                                         = RIGHT (CONS "Cons" (PAIR a as))
  81
  82 fromTree :: (Tree a)                                            -> TreeG a
  83 fromTree Tip                                                            = LEFT  (CONS "Tip" UNIT)
  84 fromTree (Bin a l r)                                            = RIGHT (CONS "Bin" (PAIR a (PAIR l r)))
  85
  86 fromTup :: (a,b)                                                        -> TupG a b
  87 fromTup (a,b)                                                           = CONS "Tuple2" (PAIR a b)
  88
  89 toT :: TG                                                                       -> T
  90 toT (CONS _ UNIT)                                                       = C
  91
  92 toColor :: ColorG                                                       -> Color
  93 toColor (LEFT (LEFT  (CONS _ UNIT)))            = Red
  94 toColor (LEFT (RIGHT (CONS _ UNIT)))            = Yellow
  95 toColor       (RIGHT (CONS _ UNIT))                     = Blue
  96
  97 toList :: (ListG a)                                                     -> [a]
  98 toList (LEFT  (CONS s UNIT))                    = []
  99 toList (RIGHT (CONS s (PAIR a as)))                     = [a:as]
 100
 101 toTree :: (TreeG a)                                                     -> Tree a
 102 toTree (LEFT  (CONS s UNIT))                = Tip
 103 toTree (RIGHT (CONS s (PAIR a (PAIR l r)))) = Bin a l r
 104
 105 toTup :: (TupG a b)                                                     -> (a,b)
 106 toTup (CONS s (PAIR a b))                                       = (a,b)
 107
 108 /**************** to test if parse and show work properly *************************/
 109
 110 test :: t -> Bool | eq0, show_0, parse0 t
 111 test x
 112         = case parse0 (show x) of
 113                 Just (y,[])     = eq0 x y
 114                 _                       = False
 115
 116 /**************** equality with a class for each kind *************************/
 117
 118 class eq0 t ::                              t       t      -> Bool
 119 class eq1 t :: (a a -> Bool)               (t a)   (t a)   -> Bool
 120 class eq2 t :: (a a -> Bool) (b b -> Bool) (t a b) (t a b) -> Bool
 121
 122 instance eq0 UNIT                       where eq0 _ _                       = True
 123 instance eq0 Int                        where eq0 n m                       = n == m
 124
 125 instance eq1 CONS                       where eq1 f   (CONS s x) (CONS t y) = s == t && f x y
 126
 127 instance eq2 PAIR                       where eq2 f g (PAIR a b) (PAIR x y) = f a x && g b y
 128 instance eq2 EITHER                     where eq2 f g (LEFT  x)  (LEFT  y)  = f x y
 129                                                               eq2 f g (RIGHT x)  (RIGHT y)  = g x y
 130                                                               eq2 f g _          _          = False
 131
 132 instance eq0 [a] | eq0 a        where eq0   l m = eq1 eq0 l m
 133 instance eq1 []                         where eq1 f l m = eq2 (eq1 eq0) (eq1 (eq2 f (eq1 f))) (fromList l) (fromList m)
 134
 135 /**************** map *************************/
 136
 137 class map0 t ::                    t      -> t
 138 class map1 t :: (a -> b)          (t a)   -> t b
 139 class map2 t :: (a -> b) (c -> d) (t a c) -> t b d
 140
 141 instance map0 Int                       where map0 i              = i
 142 instance map0 UNIT                      where map0 UNIT           = UNIT
 143
 144 instance map1 CONS                      where map1 f   (CONS n x) = CONS n (f x)
 145
 146 instance map2 PAIR                      where map2 f g (PAIR x y) = PAIR  (f x) (g y)
 147 instance map2 EITHER            where map2 f g (LEFT  x)  = LEFT  (f x)
 148                                                               map2 f g (RIGHT y)  = RIGHT (g y)
 149
 150 /**************** End Prelude *************************/
 151
 152 /**************** please add all new code below this line *************************/
 153
 154 instance eq0 Color              where eq0  c1 c2 = False                // TO BE IMPROVED
 155 instance ==  Color              where (==) c1 c2 = eq0 c1 c2    // just to use the well-known notation...
 156 instance show_0 Color   where show_0 _     c = c                // TO BE IMPROVED
 157 instance parse0 Color   where parse0 _       = Nothing  // TO BE IMPROVED
 158
 159 instance map1 []        where map1 f l = map f l                        // TO BE IMPROVED, use generic version
 160
 161 // some initial tests, please extend
 162 Start
 163  =      [ and [ test i \\ i <- [-25 .. 25]]
 164         , and [ c == toColor (fromColor c) \\ c <- [Red, Yellow, Blue]]
 165         , and [ test c \\ c <- [Red,Yellow,Blue]]
 166 //      , test [1 .. 3]
 167 //      , test [(a,b) \\ a <- [1 .. 2], b <- [5 .. 7]]
 168 //      etc.
 169         // maps
 170         , map1 ((+) 1) [0 .. 5] == [1 .. 6]
 171         ]
 172
 173 aTree = Bin 2 Tip (Bin 4 Tip Tip)