Assignment 3.1

1 files changed, 98 insertions, 10 deletions

diff --git a/assignment-3/serialize3Start.icl b/assignment-3/serialize3Start.icl
index 11eba33..70b373d 100644
--- a/assignment-3/serialize3Start.icl
+++ b/assignment-3/serialize3Start.icl
@@ -15,10 +15,21 @@ import StdEnv, StdMaybe
 :: Read a  :== [String] -> Maybe (a,[String])

 

 // use this as serialize0 for kind *

-class serialize a where

+class serialize a

+where

 	write :: a [String] -> [String]

 	read  :: [String] -> Maybe (a,[String])

 

+class serialize1 t

+where

+	write1 :: (Write a) (t a) [String] -> [String]

+	read1  :: (Read a) [String] -> Maybe (t a, [String])

+

+class serialize2 t

+where

+	write2 :: (Write a) (Write b) (t a b) [String] -> [String]

+	read2  :: (Read a) (Read b) [String] -> Maybe (t a b, [String])

+

 // ---

 

 instance serialize Bool where

@@ -43,6 +54,51 @@ instance serialize Int where
 :: PAIR   a b = PAIR a b

 :: CONS   a   = CONS String a

 

+instance serialize UNIT

+where

+	write UNIT s = s

+	read l = Just (UNIT, l)

+

+instance serialize2 EITHER

+where

+	write2 f _ (LEFT  x) s = f x s

+	write2 _ g (RIGHT x) s = g x s

+	read2 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

+

+instance serialize2 PAIR

+where

+	write2 f g (PAIR x y) s = f x [" ":g y s]

+	read2 f g s = case f s of

+		Just (x,[" ":s]) -> case g s of

+			Just (y,s) -> Just (PAIR x y,s)

+			Nothing -> Nothing

+		_ -> Nothing

+

+instance serialize1 CONS

+where

+	write1 f (CONS c x) s = cleanup ["(":c:" ":f x [")":s]]

+	where

+		// Remove redundant parentheses

+		cleanup :: [String] -> [String]

+		cleanup ["(":c:" ":")":s] = [c:s]

+		cleanup s = s

+	read1 f ["(":c:" ":s] = case f s of

+		Just (x,[")":s]) -> Just (CONS c x,s)

+		_ -> Nothing

+	// Special case for constructors without parentheses. After reading the

+	// argument, we continue with the original stream, because cleanup only

+	// removes parentheses for constructors where the write of the argument did

+	// not write anything. It is probably equivalent to continuing with the new

+	// stream (as the read should not read anything), but this seems safer.

+	read1 f [c:s] = case f s of

+		Just (x,_) -> Just (CONS c x,s)

+		Nothing -> Nothing

+	read1 _ _ = Nothing

+

 // ---

 

 :: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))

@@ -58,9 +114,12 @@ toList (RIGHT (CONS ConsString (PAIR a x))) = [a:x]
 NilString :== "Nil"

 ConsString :== "Cons"

 

-instance serialize [a] | serialize a where

- write a s = s

- read    s = Nothing

+instance serialize [a] | serialize a

+where

+	write xs s = write2 (write1 write) (write1 (write2 write write)) (fromList xs) s

+	read     s = case read2 (read1 read) (read1 (read2 read read)) s of

+		Just (xs,s) -> Just (toList xs,s)

+		Nothing -> Nothing

 

 // ---

 

@@ -85,8 +144,24 @@ instance == (Bin a) | == a where
 	(==) _ _ = False

 

 instance serialize (Bin a) | serialize a where

-	write b s = s

-	read    l = Nothing

+	write b s = write2 (write1 write) (write1 (write2 write (write2 write write))) (fromBin b) s

+	read    l = case read2 (read1 read) (read1 (read2 read (read2 read read))) l of

+		Just (b,s) -> Just (toBin b,s)

+		Nothing -> Nothing

+

+instance serialize1 Bin

+where

+	write1 _ Leaf s = [LeafString:s]

+	write1 f (Bin l x r) s = ["(":BinString:" ":write1 f l [" ":f x [" ":write1 f r [")":s]]]]

+	read1 _ [LeafString:s] = Just (Leaf,s)

+	read1 f ["(":BinString:" ":s] = case read1 f s of

+		Just (l,[" ":s]) -> case f s of

+			Just (x,[" ":s]) -> case read1 f s of

+				Just (r,[")":s]) -> Just (Bin l x r,s)

+				_ -> Nothing

+			_ -> Nothing

+		_ -> Nothing

+	read1 _ _ = Nothing

 

 // ---

 

@@ -107,16 +182,29 @@ instance == Coin where
 	(==) _    _    = False

 

 instance serialize Coin where

-	write c s = s

-	read    l = Nothing

+	write Head s = ["Head":s]

+	write Tail s = ["Tail":s]

+	read ["Head":l] = Just (Head,l)

+	read ["Tail":l] = Just (Tail,l)

+	read l = Nothing

 

 /*

 	Define a special purpose version for this type that writes and reads

 	the value (7,True) as ["(","7",",","True",")"]

 */

 instance serialize (a,b) | serialize a & serialize b where

-	write (a,b) c = c

-	read _ = Nothing

+	write t c = write2 write write t c

+	read l = read2 read read l

+

+instance serialize2 (,)

+where

+	write2 f g (x,y) s = ["(":f x [",":g y [")":s]]]

+	read2 f g ["(":s] = case f s of

+		Just (x,[",":s]) -> case g s of

+			Just (y,[")":s]) -> Just ((x,y), s)

+			_ -> Nothing

+		_ -> Nothing

+	read2 _ _ _ = Nothing

 

 // ---

 // output looks nice if compiled with "Basic Values Only" for console in project options