read1Cons

1 files changed, 32 insertions, 33 deletions

diff --git a/assignment-3/serialize3Start.icl b/assignment-3/serialize3Start.icl
index 70b373d..cfc09c3 100644
--- a/assignment-3/serialize3Start.icl
+++ b/assignment-3/serialize3Start.icl
@@ -86,18 +86,32 @@ where
 		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

+	read1 _ _ = abort "Use read1Cons instead\n"

+

+/**

+ * Special read1 variant which checks for a constructor name.

+ * @param The constructor name to match

+ * @param The read function for the constructor argument

+ * @param The stream

+ * @result The parsed constructor and the rest of the stream, if successful

+ */

+read1Cons :: String (Read a) [String] -> Maybe (CONS a, [String])

+read1Cons n f ["(":c:" ":s]

+| c == n = case f s of

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

+	_                -> Nothing

+| otherwise           = 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.

+read1Cons n f [c:s]

+| c == n = case f s of

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

+	Nothing    -> Nothing

+| otherwise     = Nothing

+read1Cons _ _ _ = Nothing

 

 // ---

 

@@ -117,7 +131,7 @@ ConsString :== "Cons"
 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

+	read     s = case read2 (read1Cons NilString read) (read1Cons ConsString (read2 read read)) s of

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

 		Nothing -> Nothing

 

@@ -145,24 +159,10 @@ instance == (Bin a) | == a where
 

 instance serialize (Bin a) | serialize a where

 	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

+	read    l = case read2 (read1Cons LeafString read) (read1Cons BinString (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

-

 // ---

 

 :: Coin = Head | Tail

@@ -182,11 +182,10 @@ instance == Coin where
 	(==) _    _    = False

 

 instance serialize Coin where

-	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

+	write c s = write2 (write1 write) (write1 write) (fromCoin c) s

+	read l = case read2 (read1Cons "Head" read) (read1Cons "Tail" read) l of

+		Just (c,l) -> Just (toCoin c,l)

+		Nothing -> Nothing

 

 /*

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