afp/a2/a2a.icl

   1 module a2a
   2
   3 import StdEnv
   4 import StdMaybe
   5
   6 class serialize a where
   7         write :: a [String] -> [String]
   8         read ::  [String] -> Maybe (a, [String])
   9
  10 :: UNIT = UNIT
  11 :: EITHER a b = LEFT a | RIGHT b
  12 :: PAIR a b = PAIR a b
  13 :: CONS a = CONS String a
  14
  15 :: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
  16
  17 fromList :: [a] -> ListG a
  18 fromList [] = LEFT (CONS "Nil" UNIT)
  19 fromList [x:xs] = RIGHT (CONS "Cons" (PAIR x xs))
  20
  21 toList :: (ListG a) -> [a]
  22 toList (LEFT (CONS "Nil" UNIT)) = []
  23 toList (RIGHT (CONS "Cons" (PAIR x xs))) = [x:xs]
  24
  25 :: BinG a :== EITHER (CONS UNIT) (CONS (PAIR (Bin a) (PAIR a (Bin a))))
  26 :: Bin a = Leaf | Bin (Bin a) a (Bin a)
  27
  28 fromBin :: (Bin a) -> BinG a
  29 fromBin Leaf = LEFT (CONS "Leaf" UNIT)
  30 fromBin (Bin l a b) = RIGHT (CONS "Bin" (PAIR l (PAIR a b)))
  31
  32 toBin :: (BinG a) -> Bin a
  33 toBin (LEFT (CONS "Leaf" UNIT)) = Leaf
  34 toBin (RIGHT (CONS "Bin" (PAIR l (PAIR a b)))) = Bin l a b
  35
  36 instance serialize Int
  37 where
  38         write i c = [toString i:c]
  39         read [i:c] = Just (toInt i, c)
  40         read _ = Nothing
  41
  42 instance serialize [a] | serialize a
  43 where
  44         write a c = write (fromList a) c
  45         read c = case read c of
  46                 Just (l, c) = Just (toList l, c)
  47                 Nothing = Nothing
  48
  49 instance serialize UNIT
  50 where
  51         write UNIT c = c
  52         read c = Just (UNIT, c)
  53
  54 instance serialize (EITHER a b) | serialize a & serialize b
  55 where
  56         write (LEFT a) c = write a c
  57         write (RIGHT a) c = write a c
  58         read c = case read c of
  59                 Just (a, c) = Just (LEFT a, c)
  60                 Nothing = case read c of
  61                         Just (a, c) = Just (RIGHT a, c)
  62                         Nothing = Nothing
  63
  64 instance serialize (PAIR a b) | serialize a & serialize b
  65 where
  66         write (PAIR a b) c = write a (write b c)
  67         read c = case read c of
  68                 Just (a, c) = case read c of
  69                         Just (b, c) = Just (PAIR a b, c)
  70                         Nothing = Nothing
  71                 Nothing = Nothing
  72
  73 instance serialize (CONS UNIT)
  74 where
  75         write (CONS n UNIT) c = [n:c]
  76         read [n:c] = Just (CONS n a, c)
  77         read _ = Nothing
  78
  79 instance serialize (CONS a) | serialize a
  80 where
  81         write (CONS n a) c
  82                 | write a [] == [] = [n:c]
  83                 = ["(",n:write a [")":c]]
  84         read ["(",n:c] = case read c of
  85                 Just (a, [")":c]) = Just (CONS n a, c)
  86                 _ = Nothing
  87         read [n:c] = case read c of
  88                 Just (a, c) = Just (CONS n a, c)
  89                 Nothing = Nothing
  90         read _ = Nothing
  91
  92 Start :: (Maybe ([[Int]], [String]), [String])
  93 Start = (read (write (fromList what) []), write (fromList what) [])
  94 where
  95         what :: [[Int]]
  96         what = [[1,2],[1,2,3]]
  97