From 8ef58089d2b29703d1bf3910656b298a5ac31932 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Tue, 26 Sep 2017 20:00:54 +0200
Subject: read1Cons

---
 assignment-3/serialize3Start.icl | 65 ++++++++++++++++++++--------------------
 1 file changed, 32 insertions(+), 33 deletions(-)

(limited to 'assignment-3')

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
-- 
cgit v1.2.3