afp/a3/serializenative.icl

   1 module serializenative
   2
   3 import StdEnv, StdMaybe, StdGeneric
   4
   5 class serialize a | read{|*|}, write{|*|} a
   6
   7 generic write a :: a [String] -> [String]
   8 generic read a :: [String] -> Maybe (a, [String])
   9
  10 write{|Bool|} b c = [toString b:c]
  11 read{|Bool|} ["True":c] = Just (True, c)
  12 read{|Bool|} ["False":c] = Just (False, c)
  13 read{|Bool|} _ = Nothing
  14
  15 write{|Int|} i c = [toString i:c]
  16 read{|Int|} [i:c] = Just (toInt i, c)
  17 read{|Int|} _ = Nothing
  18
  19 write{|UNIT|} UNIT c = c
  20 read{|UNIT|} c = Just (UNIT, c)
  21
  22 write{|EITHER|} wl _  (LEFT a) c = wl a c
  23 write{|EITHER|} _  wr (RIGHT a) c = wr a c
  24 read{|EITHER|} rl rr c = case rl c of
  25         Just (a, c) = Just (LEFT a, c)
  26         Nothing = case rr c of
  27                 Just (a, c) = Just (RIGHT a, c)
  28                 Nothing = Nothing
  29
  30 write{|PAIR|} wl wr (PAIR l r) c = wl l (wr r c)
  31 read{|PAIR|} rl rr c = case rl c of
  32         Just (a, c) = case rr c of
  33                 Just (b, c) = Just (PAIR a b, c)
  34                 Nothing = Nothing
  35         Nothing = Nothing
  36
  37 write{|CONS of {gcd_name}|} wa (CONS a) c = ["(",gcd_name:wa a [")":c]]
  38 read{|CONS|} ra ["(",n:c] = case ra c of
  39         Just (a, [")":c]) = Just (CONS a, c)
  40         _ = Nothing
  41 read{|CONS|} _ _ = Nothing
  42
  43 write{|OBJECT|} wa (OBJECT a) c = wa a c
  44 read{|OBJECT|} ra c = case ra c of
  45         Just (a, c) = Just (OBJECT a, c)
  46         _ = Nothing
  47
  48 :: Bin a = Leaf | Bin (Bin a) a (Bin a)
  49
  50 instance == (Bin a) | == a where
  51   (==) Leaf Leaf = True
  52   (==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s
  53   (==) _ _ = False
  54
  55 :: Coin = Head | Tail
  56
  57 instance == Coin where
  58   (==) Head Head = True
  59   (==) Tail Tail = True
  60   (==) _    _    = False
  61
  62 derive class serialize Coin, Bin, (,), []
  63
  64 // output looks nice if compiled with "Basic Values Only" for console in project options
  65 Start =
  66   [test True
  67   ,test False
  68   ,test 0
  69   ,test 123
  70   ,test -36
  71   ,test [42]
  72   ,test [0..4]
  73   ,test [[True],[]]
  74   ,test [[[1]],[[2],[3,4]],[[]]]
  75   ,test (Bin Leaf True Leaf)
  76   ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))]
  77   ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))]
  78   ,test Head
  79   ,test Tail
  80   ,test (7,True)
  81   ,test (Head,(7,[Tail]))
  82   ,["End of the tests.\n"]
  83   ]
  84
  85 test :: a -> [String] | serialize, == a
  86 test a =
  87   (if (isJust r)
  88     (if (fst jr == a)
  89       (if (isEmpty (tl (snd jr)))
  90         ["Oke"]
  91         ["Not all input is consumed! ":snd jr])
  92       ["Wrong result: ":write{|*|} (fst jr) []])
  93     ["read result is Nothing"]
  94   ) ++ [", write produces: ": s]
  95   where
  96     s = write{|*|} a ["\n"]
  97     r = read{|*|} s
  98     jr = fromJust r