diff options
Diffstat (limited to 'assignment-2/serialize2start.icl')
| -rw-r--r-- | assignment-2/serialize2start.icl | 100 |
1 files changed, 81 insertions, 19 deletions
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]))
|