From dd8833e83e91a28bbb1d9fa2e282554a26e3288c Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Tue, 19 Sep 2017 20:26:28 +0200
Subject: Up to 2.1

---
 assignment-2/serialize2start.icl | 173 ++++++++++++++++++++++++++++-----------
 1 file changed, 126 insertions(+), 47 deletions(-)

(limited to 'assignment-2')

diff --git a/assignment-2/serialize2start.icl b/assignment-2/serialize2start.icl
index 14e0037..92d4631 100644
--- a/assignment-2/serialize2start.icl
+++ b/assignment-2/serialize2start.icl
@@ -8,24 +8,47 @@ module serialize2start
 
 import StdEnv, StdMaybe
 
+/**
+ * Review questions
+ *
+ * 1. A type is a set of values. In the case of UNIT, UNIT = {UNIT}. The set of
+ * possible arguments to == on a type T is {(x,y) | x <- T, y <- T}, so in the
+ * case of UNIT we have {(UNIT,UNIT)}. Hence, this alternative matches always.
+ * The other suggestions are equivalent, as the pattern match is because of
+ * this meaningless and therefore all alternatives in the question are
+ * equivalent.
+ *
+ * 2. The name of the constructor is redundant information, since the same
+ * information can also be derived (compile-time only, hence it has to be
+ * stored) from the LEFT/RIGHT-path through the ADT tree. Hence, checking on
+ * the constructor name is not needed.
+ *
+ * 3.
+ * - []   = LEFT (CONS "_Nil" UNIT)
+ * - Leaf = LEFT (CONS "Leaf" UNIT)
+ * == has type a a -> Bool, so we cannot apply it to Leaf and [], which are not
+ * of the same type. So no, this does not yield True (it does not yield
+ * anything, as you won't be able to compile it).
+ */
+
 class serialize a where
-  write :: a [String] -> [String]
-  read  :: [String] -> Maybe (a,[String])
+	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
+	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 [s:r]
-    # i = toInt s
-    | s == toString i
-      = Just (i,r)
-      = Nothing
-  read _ = Nothing
+	write i c = [toString i:c]
+	read [s:r]
+		# i = toInt s
+		| s == toString i
+			= Just (i,r)
+			= Nothing
+	read _ = Nothing
 
 // ---
 
@@ -36,52 +59,108 @@ instance serialize Int where
 
 // ---
 
+instance serialize UNIT
+where
+	write UNIT c = ["UNIT":c]
+	read ["UNIT":r] = Just (UNIT, r)
+	read _          = Nothing
+
+instance serialize (EITHER a b) | serialize a & serialize b
+where
+	write (LEFT x)  c = ["LEFT": write x c]
+	write (RIGHT x) c = ["RIGHT":write x c]
+	read ["LEFT":r] = case read r of
+		Just (x,r) -> Just (LEFT x, r)
+		Nothing    -> Nothing
+	read ["RIGHT":r] = case read r of
+		Just (x,r) -> Just (RIGHT x, r)
+		Nothing    -> Nothing
+	read _ = Nothing
+
+instance serialize (PAIR a b) | serialize a & serialize b
+where
+	write (PAIR x y) c = write x (write y c)
+	read r = case read r of
+		Nothing    -> Nothing
+		Just (x,r) -> case read r of
+			Nothing    -> Nothing
+			Just (y,r) -> Just (PAIR x y, r)
+
+instance serialize (CONS a) | serialize a
+where
+	write (CONS _ x) c = write x c
+	read r = case read r of
+		Just (x,r) -> Just (CONS "" x,r)
+		Nothing    -> Nothing
+
 :: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
 
-instance serialize [a] | serialize a where  // to be imporved
-  write l c = c
-  read l = Nothing
+fromList :: [a] -> ListG a
+fromList []     = LEFT (CONS "_Nil" UNIT)
+fromList [x:xs] = RIGHT (CONS "_Cons" (PAIR x xs))
+
+toList :: (ListG a) -> [a]
+toList (LEFT _)                     = []
+toList (RIGHT (CONS _ (PAIR x xs))) = [x:xs]
+
+instance serialize [a] | serialize a
+where
+	write l c = write (fromList l) c
+	read l = case read l of
+		Just (g,r) -> Just (toList g,r)
+		Nothing    -> Nothing
 
 :: Bin a = Leaf | Bin (Bin a) a (Bin a)
 :: BinG a :== EITHER (CONS UNIT) (CONS (PAIR (Bin a) (PAIR a (Bin a))))
 
-instance serialize (Bin a) | serialize a where // to be imporved
-  write a c = c
-  read l = Nothing
+fromBin :: (Bin a) -> BinG a
+fromBin Leaf        = LEFT (CONS "Leaf" UNIT)
+fromBin (Bin l x r) = RIGHT (CONS "Bin" (PAIR l (PAIR x r)))
+
+toBin :: (BinG a) -> Bin a
+toBin (LEFT _)                             = Leaf
+toBin (RIGHT (CONS _ (PAIR l (PAIR x r)))) = Bin l x r
+
+instance serialize (Bin a) | serialize a
+where
+	write a c = write (fromBin a) c
+	read l = case read l of
+		Just (g,r) -> Just (toBin g,r)
+		Nothing    -> Nothing
 
 instance == (Bin a) | == a where // better use the generic approach
-  (==) Leaf Leaf = True
-  (==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s
-  (==) _ _ = False
+	(==) Leaf Leaf = True
+	(==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s
+	(==) _ _ = False
 
 // ---
 
 Start = 
-  [test True
-  ,test False
-  ,test 0
-  ,test 123
-  ,test -36
-  ,test [42]
-  ,test [0..4]
-  ,test [[True],[]]
-  ,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 True
+	, test False
+	, test 0
+	, test 123
+	, test -36
+	, test [42]
+	, test [0..4]
+	, test [[True],[]]
+	, 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 :: a -> ([String],[String]) | serialize, == a
 test a = 
-  (if (isJust r)
-    (if (fst jr == a)
-      (if (isEmpty (tl (snd jr)))
-        ["Oke "]
-        ["Fail: not all input is consumed! ":snd jr])
-      ["Fail: Wrong result ":write (fst jr) []])
-    ["Fail: read result is Nothing "]
-  , ["write produces ": s]
-  )
-  where
-    s = write a ["\n"]
-    r = read s
-    jr = fromJust r
+	(if (isJust r)
+		(if (fst jr == a)
+			(if (isEmpty (tl (snd jr)))
+				["Oke "]
+				["Fail: not all input is consumed! ":snd jr])
+			["Fail: Wrong result ":write (fst jr) []])
+		["Fail: read result is Nothing "]
+	, ["write produces ": s]
+	)
+	where
+		s = write a ["\n"]
+		r = read s
+		jr = fromJust r
-- 
cgit v1.2.3