afp/a1/a.icl

   1 module a
   2
   3 import StdFunc
   4 import StdEnv
   5 import Data.Maybe
   6 import Data.Func
   7 import Data.List
   8
   9 import Gast
  10
  11 :: Bin a = Leaf | Bin (Bin a) a (Bin a)
  12 :: Rose a = Rose a [Rose a]
  13
  14 class serialize a where
  15         write :: a [String] -> [String]
  16         read :: [String] -> Maybe (a, [String])
  17
  18 instance serialize Bool where
  19         write b c = [toString b:c]
  20         read ["True":r] = Just (True, r)
  21         read ["False":r] = Just (False, r)
  22         read _ = Nothing
  23
  24 instance serialize Int where
  25         write i c = [toString i:c]
  26         read [c:r] = Just (toInt c, r)
  27         read _ = Nothing
  28
  29 instance serialize [a] | serialize a where
  30         write l c = ["[":foldr write ["]"] l]
  31         read ["[":t] = read` t
  32         where
  33                 read` ["]":t] = Just ([], t)
  34                 read` t = case read t of
  35                         Nothing = Nothing
  36                         Just (e, t) = case read` t of
  37                                 Nothing = Nothing
  38                                 Just (es, t) = Just ([e:es], t)
  39         read _ = Nothing
  40
  41 instance serialize (Bin a) | serialize a where
  42         write Leaf c = ["Leaf":c]
  43         write (Bin l a r) c = ["Bin":write l (write a (write r c))]
  44         read ["Leaf":t] = Just (Leaf, t)
  45         read ["Bin":t] = case read t of
  46                 Nothing = Nothing
  47                 Just (l, t) = case read t of
  48                         Nothing = Nothing
  49                         Just (a, t) = case read t of
  50                                 Nothing = Nothing
  51                                 Just (r, t) = Just (Bin l a r, t)
  52         read _ = Nothing
  53
  54 instance serialize (Rose a) | serialize a where
  55         write (Rose a l) c = ["Rose":write a (write l c)]
  56         read ["Rose":t] = case read t of
  57                 Nothing = Nothing
  58                 Just (a, t) = case read t of
  59                         Nothing = Nothing
  60                         Just (l, t) = Just (Rose a l, t)
  61         read _ = Nothing
  62
  63 test :: a -> (Bool, [String]) | serialize, ==a
  64 test a = (isJust r && fst jr == a && isEmpty (tl (snd jr)) , s)
  65 where
  66         s = write a [" \n"]
  67         r = read s
  68         jr = fromJust r
  69
  70 //Bool , Bin , Rose , Bin Int , Tree , T1 , T2 , T3 , and T4
  71 //Bool    : *
  72 //Bin     : * -> *
  73 //Rose    : * -> *
  74 //Bin Int : *
  75 //Tree    : * -> * -> *
  76 //T1      : (* -> *) -> * -> *
  77 //T2      : (* -> *) -> (* -> *) -> * -> *
  78 //T3      : (* -> * -> *) -> * -> * -> *
  79 //T4      : (* -> *) -> (* -> *) -> * -> *
  80
  81 class Container t where
  82         Cinsert :: a (t a) -> t a | < a
  83         Ccontains :: a (t a) -> Bool | <, Eq a
  84         Cshow :: (t a) -> [String] | toString a
  85         Cnew :: t a
  86
  87 instance Container [] where
  88         Cinsert a l = [a:l]
  89         Ccontains a l = isMember a l
  90         Cshow l = ["[":intersperse "," (map toString l)] ++ ["]"]
  91         Cnew = []
  92
  93 instance Container Bin where
  94         Cinsert a Leaf = Bin Leaf a Leaf
  95         Cinsert a (Bin l e r)
  96                 | a <= e = Bin (Cinsert a l) e r
  97                 = Bin l e (Cinsert a r)
  98         Ccontains a Leaf = False
  99         Ccontains a (Bin l e r)
 100                 | a == e = True
 101                 | a < e = Ccontains a l
 102                 = Ccontains a r
 103         Cshow Leaf = ["Leaf"]
 104         Cshow (Bin l a r) = ["Bin (":Cshow l] ++ [") ",toString a," (":Cshow r] ++ [")"]
 105         Cnew = Leaf