old/afp/a2/a2.icl

   1 module a2
   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 = ["UNIT":c]
  52         read ["UNIT":c] = Just (UNIT, c)
  53         read _ = Nothing
  54
  55 instance serialize (EITHER a b) | serialize a & serialize b
  56 where
  57         write (LEFT a) c = ["LEFT":write a c]
  58         write (RIGHT a) c = ["RIGHT":write a c]
  59         read ["LEFT":c] = case read c of
  60                 Just (a, c) = Just (LEFT a, c)
  61                 Nothing = Nothing
  62         read ["RIGHT":c] = case read c of
  63                 Just (a, c) = Just (RIGHT a, c)
  64                 Nothing = Nothing
  65         read _ = Nothing
  66
  67 instance serialize (PAIR a b) | serialize a & serialize b
  68 where
  69         write (PAIR a b) c = ["PAIR":write a (write b c)]
  70         read ["PAIR":c] = case read c of
  71                 Just (a, c) = case read c of
  72                         Just (b, c) = Just (PAIR a b, c)
  73                         Nothing = Nothing
  74                 Nothing = Nothing
  75         read _ = Nothing
  76
  77 instance serialize (CONS a) | serialize a
  78 where
  79         write (CONS n a) c = ["CONS",n:write a c]
  80         read ["CONS",n:c] = case read c of
  81                 Just (a, c) = Just (CONS n a, c)
  82                 Nothing = Nothing
  83         read _ = Nothing
  84
  85 Start :: Maybe ([Int], [String])
  86 Start = read (write (fromList [1,2]) [])