a3/mart_map2/skeleton3b.icl

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