From 5119445773d095ef1eab99f917362eb6fb06303f Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Tue, 19 Sep 2017 21:20:50 +0200
Subject: Pretty-printing

---
 assignment-2/serialize2start.icl | 100 +++++++++++++++++++++++++++++++--------
 1 file changed, 81 insertions(+), 19 deletions(-)

(limited to 'assignment-2')

diff --git a/assignment-2/serialize2start.icl b/assignment-2/serialize2start.icl
index 92d4631..61c81d7 100644
--- a/assignment-2/serialize2start.icl
+++ b/assignment-2/serialize2start.icl
@@ -31,7 +31,55 @@ import StdEnv, StdMaybe
  * anything, as you won't be able to compile it).
  */
 
-class serialize a where
+/**
+ * The number of elements in an expression that will be placed on the outer
+ * level w.r.t. parentheses when pretty-printing.
+ *
+ * For instance:
+ *  - "37"             -> 1
+ *  - "_Nil"           -> 1
+ *  - "_Cons 1 _Nil"   -> 3
+ *  - "(_Cons 1 _Nil)" -> 1
+ */
+class outerElems a
+where
+	outerElems :: a -> Int
+
+	/**
+	 * An expression needs parentheses when it has more than one element on the
+	 * outer level.
+	 */
+	needsParens x :== outerElems x > 1
+
+/**
+ * In the default case, parentheses are placed around the whole expression, so
+ * the number of elements on the outer level is 1.
+ */
+instance outerElems a    where outerElems _ = 1
+
+//* UNITs are not printed.
+instance outerElems UNIT where outerElems _ = 0
+
+//* The arguments and the constructor
+instance outerElems (CONS a) | outerElems a
+where outerElems (CONS _ x) = 1 + outerElems x
+
+//* Both elements appear on the outer level
+instance outerElems (PAIR a b) | outerElems a & outerElems b
+where outerElems (PAIR x y) = outerElems x + outerElems y
+
+instance outerElems (EITHER a b) | outerElems a & outerElems b
+where
+	outerElems (LEFT x)  = outerElems x
+	outerElems (RIGHT x) = outerElems x
+
+/**
+ * We extended the definition with a restriction on outerElems. This extra
+ * restriction is OK, since there is an instance of outerElems for every type
+ * (and hence, this restriction does not exclude any type).
+ */
+class serialize a | outerElems a
+where
 	write :: a [String] -> [String]
 	read	:: [String] -> Maybe (a,[String])
 
@@ -59,39 +107,53 @@ instance serialize Int where
 
 // ---
 
+writeP :: a [String] -> [String] | serialize a
+writeP x s = if (needsParens x) ["(":write x [")":s]] (write x s)
+
+readP :: [String] -> Maybe (a, [String]) | serialize a
+readP ["(":r] = case read r of
+	Just (x,[")":r]) -> Just (x,r)
+	_                -> read ["(":r]
+readP r = case read r of
+	Just (x,r) -> if (needsParens x) Nothing (Just (x,r))
+	_          -> Nothing
+
 instance serialize UNIT
 where
-	write UNIT c = ["UNIT":c]
-	read ["UNIT":r] = Just (UNIT, r)
-	read _          = Nothing
+	write _ c = c
+	read r = Just (UNIT,r)
 
 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
+	write (LEFT x)  c = write x c
+	write (RIGHT x) c = write x c
+	read 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
+		Nothing    -> case read r of
+			Just (x,r) -> Just (RIGHT x,r)
+			Nothing    -> 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
+	write (PAIR x y) c = writeP x [" ":writeP y c]
+	read r = case readP r of
+		Just (x,[" ":r]) -> case readP r of
 			Nothing    -> Nothing
 			Just (y,r) -> Just (PAIR x y, r)
+		_ -> Nothing
 
 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)
+	write e=:(CONS s x) c
+	| needsParens e = ["(":s:" ":write x [")":c]]
+	| otherwise     = [s:c]
+	read ["(":s:" ":r] = case read r of
+		Just (x,[")":r]) -> Just (CONS s x,r)
+		_                -> Nothing
+	read [s:r] = case read r of
+		Just (x,r) -> let e = CONS s x in if (needsParens e) Nothing (Just (e,r))
 		Nothing    -> Nothing
+	read _ = Nothing
 
 :: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))
 
-- 
cgit v1.2.3