afp

[clean-tests.git] / afp / a1 / a.icl

diff --git a/afp/a1/a.icl b/afp/a1/a.icl
new file mode 100644 (file)
index 0000000..6912af5
--- /dev/null
+++ b/afp/a1/a.icl
@@ -0,0 +1,105 @@
+module a
+
+import StdFunc
+import StdEnv
+import Data.Maybe
+import Data.Func
+import Data.List
+
+import Gast
+
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)
+:: Rose a = Rose a [Rose a]
+
+class serialize a where
+       write :: a [String] -> [String]
+       read :: [String] -> Maybe (a, [String])
+
+instance serialize Bool where
+       write b c = [toString b:c]
+       read ["True":r] = Just (True, r)
+       read ["False":r] = Just (False, r)
+       read _ = Nothing
+
+instance serialize Int where
+       write i c = [toString i:c]
+       read [c:r] = Just (toInt c, r)
+       read _ = Nothing
+
+instance serialize [a] | serialize a where
+       write l c = ["[":foldr write ["]"] l]
+       read ["[":t] = read` t
+       where
+               read` ["]":t] = Just ([], t)
+               read` t = case read t of
+                       Nothing = Nothing
+                       Just (e, t) = case read` t of
+                               Nothing = Nothing
+                               Just (es, t) = Just ([e:es], t)
+       read _ = Nothing
+
+instance serialize (Bin a) | serialize a where
+       write Leaf c = ["Leaf":c]
+       write (Bin l a r) c = ["Bin":write l (write a (write r c))]
+       read ["Leaf":t] = Just (Leaf, t)
+       read ["Bin":t] = case read t of
+               Nothing = Nothing
+               Just (l, t) = case read t of
+                       Nothing = Nothing
+                       Just (a, t) = case read t of
+                               Nothing = Nothing
+                               Just (r, t) = Just (Bin l a r, t)
+       read _ = Nothing
+
+instance serialize (Rose a) | serialize a where
+       write (Rose a l) c = ["Rose":write a (write l c)]
+       read ["Rose":t] = case read t of
+               Nothing = Nothing
+               Just (a, t) = case read t of
+                       Nothing = Nothing
+                       Just (l, t) = Just (Rose a l, t)
+       read _ = Nothing
+
+test :: a -> (Bool, [String]) | serialize, ==a
+test a = (isJust r && fst jr == a && isEmpty (tl (snd jr)) , s)
+where
+       s = write a [" \n"]
+       r = read s
+       jr = fromJust r
+
+//Bool , Bin , Rose , Bin Int , Tree , T1 , T2 , T3 , and T4
+//Bool    : *
+//Bin     : * -> *
+//Rose    : * -> *
+//Bin Int : *
+//Tree    : * -> * -> *
+//T1      : (* -> *) -> * -> *
+//T2      : (* -> *) -> (* -> *) -> * -> *
+//T3      : (* -> * -> *) -> * -> * -> *
+//T4      : (* -> *) -> (* -> *) -> * -> *
+
+class Container t where
+       Cinsert :: a (t a) -> t a | < a
+       Ccontains :: a (t a) -> Bool | <, Eq a
+       Cshow :: (t a) -> [String] | toString a
+       Cnew :: t a
+
+instance Container [] where
+       Cinsert a l = [a:l]
+       Ccontains a l = isMember a l
+       Cshow l = ["[":intersperse "," (map toString l)] ++ ["]"]
+       Cnew = []
+
+instance Container Bin where
+       Cinsert a Leaf = Bin Leaf a Leaf
+       Cinsert a (Bin l e r)
+               | a <= e = Bin (Cinsert a l) e r
+               = Bin l e (Cinsert a r)
+       Ccontains a Leaf = False
+       Ccontains a (Bin l e r)
+               | a == e = True
+               | a < e = Ccontains a l
+               = Ccontains a r
+       Cshow Leaf = ["Leaf"]
+       Cshow (Bin l a r) = ["Bin (":Cshow l] ++ [") ",toString a," (":Cshow r] ++ [")"]
+       Cnew = Leaf