diff options
Diffstat (limited to 'assignment-3')
-rw-r--r-- | assignment-3/serialize3Native.icl | 110 |
1 files changed, 110 insertions, 0 deletions
diff --git a/assignment-3/serialize3Native.icl b/assignment-3/serialize3Native.icl new file mode 100644 index 0000000..3f0461b --- /dev/null +++ b/assignment-3/serialize3Native.icl @@ -0,0 +1,110 @@ +module serialize3Native + +import StdEnv +import StdGeneric +import StdMaybe + +:: Bin a = Leaf | Bin (Bin a) a (Bin a) +instance == (Bin a) | == a where + (==) Leaf Leaf = True + (==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s + (==) _ _ = False + +:: Coin = Head | Tail +instance == Coin where + (==) Head Head = True + (==) Tail Tail = True + (==) _ _ = False + +generic read a :: [String] -> Maybe (a, [String]) +read{|Bool|} ["True":s] = Just (True,s) +read{|Bool|} ["False":s] = Just (False,s) +read{|Bool|} _ = Nothing +read{|Int|} ["0":s] = Just (0,s) +read{|Int|} [i:s] = case toInt i of + 0 -> Nothing + i -> Just (i,s) +read{|Int|} _ = Nothing +read{|UNIT|} s = Just (UNIT,s) +read{|PAIR|} f g s = case f s of + Just (x,[" ":s]) -> case g s of + Just (y,s) -> Just (PAIR x y,s) + _ -> Nothing + _ -> Nothing +read{|CONS of d|} f ["(":c:" ":s] +| c == d.gcd_name = case f s of + Just (x,[")":s]) -> Just (CONS x,s) + _ -> Nothing +| otherwise = Nothing +read{|CONS of d|} f [c:s] +| d.gcd_arity == 0 && d.gcd_name == c = case f s of + Just (x,_) -> Just (CONS x,s) + Nothing -> Nothing +| otherwise = Nothing +read{|EITHER|} f g s = case f s of + Just (x,s) -> Just (LEFT x,s) + Nothing -> case g s of + Just (x,s) -> Just (RIGHT x,s) + Nothing -> Nothing +read{|OBJECT|} f s = case f s of + Just (x,s) -> Just (OBJECT x,s) + _ -> Nothing +read{|(,)|} f g ["(":s] = case f s of + Just (x,[",":s]) -> case g s of + Just (y,[")":s]) -> Just ((x,y),s) + _ -> Nothing + _ -> Nothing + +derive read [], Bin, Coin + +generic write a :: a [String] -> [String] +write{|Bool|} b s = [toString b:s] +write{|Int|} x s = [toString x:s] +write{|UNIT|} UNIT s = s +write{|PAIR|} f g (PAIR x y) s = f x [" ":g y s] +write{|CONS of d|} f (CONS x) s +| d.gcd_arity == 0 = [d.gcd_name:s] +| otherwise = ["(":d.gcd_name:" ":f x [")":s]] +write{|EITHER|} f g (LEFT x) s = f x s +write{|EITHER|} f g (RIGHT x) s = g x s +write{|OBJECT|} f (OBJECT x) s = f x s +write{|(,)|} f g (x,y) s = ["(":f x [",":g y [")":s]]] + +derive write [], Bin, Coin + +class serialize a | read{|*|}, write{|*|} a + +Start = + [test True + ,test False + ,test 0 + ,test 123 + ,test -36 + ,test [42] + ,test [0..4] + ,test [[True],[]] + ,test [[[1]],[[2],[3,4]],[[]]] + ,test (Bin Leaf True Leaf) + ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))] + ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))] + ,test Head + ,test Tail + ,test (7,True) + ,test (Head,(7,[Tail])) + ,["End of the tests.\n"] + ] + +test :: a -> [String] | serialize, == a +test a = + (if (isJust r) + (if (fst jr == a) + (if (isEmpty (tl (snd jr))) + ["Oke"] + ["Not all input is consumed! ":snd jr]) + ["Wrong result: ":write{|*|} (fst jr) []]) + ["read result is Nothing"] + ) ++ [", write produces: ": s] + where + s = write{|*|} a ["\n"] + r = read{|*|} s + jr = fromJust r |