a3/mart_map2/skeleton3b.icl

   1 module skeleton3b
   2 /*
   3         Mart Lubbers s4109503
   4         Charlie Gerhardus s3050009
   5 */
   6
   7 /*
   8         Advanced Programming.
   9         Skeleton for exercise 3.3 and 3.4.
  10         To be used in a project with the environment Everything,
  11         or StdEnv with an import of StdMaybe from StdLib
  12
  13         Pieter Koopman, pieter@cs.ru.nl
  14 */
  15
  16 import StdEnv, StdGeneric, StdMaybe, GenEq
  17
  18 //------------------ show --------------
  19 generic show_ a :: a [String] -> [String]
  20
  21 show_{|Int|}  i c = [toString i:c]
  22 show_{|Bool|} b c = [toString b:c]
  23 show_{|UNIT|} _ c = c
  24
  25 show a = show_{|*|} a []
  26
  27 //------------------ parse --------------
  28
  29 :: Result a :== Maybe (a, [String])
  30
  31 generic parse a :: [String] -> Result a
  32
  33 parse{|Bool|} ["True" :r] = Just (True ,r)
  34 parse{|Bool|} ["False":r] = Just (False,r)
  35 parse{|Bool|} _ = Nothing
  36
  37 //------------------ some data types --------------
  38
  39 :: T            = C
  40 :: Color        = Red | Yellow | Blue
  41 :: Tree a       = Tip | Bin a (Tree a) (Tree a)
  42
  43 //------------------ general useful --------------
  44
  45 instance + String where (+) s t = s+++t
  46 derive bimap Maybe, []
  47
  48 //------------------ to test if parse and show work properly --------------
  49
  50 test :: t -> Bool | gEq{|*|}, show_{|*|}, parse{|*|} t
  51 test x
  52         = case parse{|*|} (show x) of
  53                 Just (y,[])     = x === y
  54                 _                       = False
  55
  56 /***** End Prelude, add all new code below this line *************************/
  57 //Show stuff
  58 show_{|OBJECT|} f (OBJECT x) c = f x c
  59 show_{|CONS of {gcd_name, gcd_arity}|} f (CONS x) c
  60 | gcd_arity == 0 = [gcd_name:f x c]
  61 | otherwise = ["(":gcd_name:f x [")":c]]
  62 show_{|PAIR|} f1 f2 (PAIR x1 x2) c = f1 x1 (f2 x2 c)
  63 show_{|EITHER|} f _ (LEFT x) c = f x c
  64 show_{|EITHER|} _ f (RIGHT x) c = f x c
  65 show_{|(,)|} f1 f2 (x1, x2) c = ["("] ++ f1 x1 [",":f2 x2 c]++[")"]
  66
  67 derive show_ T, [], Color, Tree
  68
  69 //Parse stuff (monads would make this more neat)
  70 parse{|Int|} [i:r] = Just (toInt i, r)
  71 parse{|Int|} _ = Nothing
  72 parse{|UNIT|} r = Just (UNIT, r)
  73 parse{|OBJECT|} f r = case f r of
  74         Just (x, r) = Just (OBJECT x, r)
  75         _ = Nothing
  76 parse{|CONS of {gcd_name, gcd_arity}|} f r
  77 | gcd_arity == 0 = case r of
  78         [gcd_name:r] = case f r of
  79                 Just (x, r) = Just (CONS x, r)
  80                 _ = Nothing
  81         _ = Nothing
  82 | otherwise = case r of
  83         ["(",gcd_name:r] = case f r of
  84                 Just (x, r) = Just (CONS x, r % (0, (length r) - 2))
  85                 _ = Nothing
  86         _ = Nothing
  87 parse{|PAIR|} f1 f2 r = case f1 r of
  88         Just (x1, r) = case f2 r of
  89                 Just (x2, r) = Just (PAIR x1 x2, r)
  90                 _ = Nothing
  91         _ = Nothing
  92 parse{|EITHER|} f1 f2 r = case f2 r of
  93         Just (x, r) = Just (RIGHT x, r)
  94         _ = case f1 r of
  95                 Just (x, r) = Just (LEFT x, r)
  96                 _ = Nothing
  97 parse{|(,)|} f1 f2 ["(":r] = case f1 r of
  98         Just (x1, r) = case r of
  99                 [",":r] = case f2 r of
 100                         Just (x2, r) = Just ((x1, x2), r % (0, (length r) - 2))
 101                         _ = Nothing
 102                 _ = Nothing
 103         _ = Nothing
 104
 105 derive parse T, [], Color, Tree
 106 Start = show 42