done

week07job/week07job.icl

@@ -32,26 +32,29 @@ instance serialize Int where
       = Nothing
   read _ = Nothing
 
-// ---
-
-instance == UNIT where
-  (==) _ _ = True
-
 :: UNIT       = UNIT
 :: EITHER a b = LEFT a | RIGHT b
 :: PAIR   a b = PAIR a b
 :: CONS   a   = CONS String a
 
-instance unitDecidable UNIT where
-  isUnit _ = True
+instance == (PAIR a b) | == a & == b where
+  (==) (PAIR a b) (PAIR a2 b2) = a == a2 && b == b2
 
-instance unitDecidable (EITHER a b) where
-  isUnit _ = False
+instance == (CONS a) | == a where
+  (==) (CONS _ a) (CONS _ a2) = a == a2
 
-instance unitDecidable (PAIR a b) where
-  isUnit _ = False
+instance == UNIT where
+  (==) _ _ = True
+
+instance == (EITHER a b) | == a & == b where
+  (==) (LEFT a) (LEFT a2)   = a == a2
+  (==) (RIGHT b) (RIGHT b2) = b == b2
+  (==) _ _ = False
+
+instance unitDecidable UNIT where
+  isUnit _ = True
 
-instance unitDecidable (CONS a) where
+instance unitDecidable a where
   isUnit _ = False
 
 // ---
@@ -113,18 +116,18 @@ instance serialize (PAIR a b) | serialize a & serialize b where
 
 instance serialize (CONS a) | serialize a & unitDecidable a where
   write (CONS str a) c
-    | (isUnit a)  = ["!" : str : write a c]
+    | (isUnit a)  = [str : write a c]
     | otherwise = ["[":str:(write a ["]":c])]
   read ["[":str:xs] = case read xs of
     Just (a, ["]":rest]) -> Just(CONS str a, rest)
     Just (a, rest)       -> Nothing
     Nothing              -> Nothing
-  read ["!":str:xs] = case read [str] of
+  read [str:xs] = case read [str] of
     Just (a, r) -> Just(CONS str a, xs)
     Nothing     -> Nothing
   read _ = Nothing
 
-instance serialize [a] | serialize a where  // to be improved
+instance serialize [a] | serialize a where
   write l c = write (fromList l) c
   read l = case (read l) of
     Just (e, rest) -> Just (toList e, rest)
@@ -133,23 +136,34 @@ instance serialize [a] | serialize a where  // to be improved
 :: 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 improved
+:: Coin = Head | Tail
+:: CoinG :== EITHER (CONS UNIT) (CONS UNIT)
+
+instance serialize (Bin a) | serialize a where
   write a c = write (fromBin a) c
   read l = case (read l) of
     Just (e, rest) -> Just (toBin e, rest)
     _              -> 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
+instance == (Bin a) | == a where
+  (==) t1 t2 = (fromBin t1) == (fromBin t2)
 
 // ---
 
+intLeaf :: Bin Int
+intLeaf = Leaf
+
+intNothing :: Maybe Int
+intNothing = Nothing
+
 Start =
   [test True
   ,test False
-  ,test 0
+  ,test intLeaf
+  ,test Head
+  ,test Tail
+  ,test (Just 0)
+  ,test intNothing
   ,test 123
   ,test -36
   ,test [42]
@@ -205,3 +219,40 @@ fromBin (Bin l e r) = RIGHT (CONS "Bin" (PAIR l (PAIR e r)))
 toBin :: (BinG a) -> (Bin a)
 toBin (LEFT a)                             = Leaf
 toBin (RIGHT (CONS _ (PAIR l (PAIR e r)))) = (Bin l e r)
+
+//Coin Counterexample needed for ex3
+
+instance == Coin where
+  (==) c1 c2 = (fromCoin c1) == (fromCoin c2)
+
+fromCoin :: Coin -> CoinG
+fromCoin Head = LEFT (CONS "Head" UNIT)
+fromCoin Tail = RIGHT (CONS "Tail" UNIT)
+
+toCoin :: CoinG -> Coin
+toCoin (LEFT _)  = Head
+toCoin (RIGHT _) = Tail
+
+instance serialize Coin where
+  write c cont = write (fromCoin c) cont
+  read r = case read r of
+    Just (c, rest) -> Just(toCoin c, rest)
+    _              -> Nothing
+
+//Maybe
+
+:: MaybeG a :== (EITHER (CONS UNIT) (CONS a))
+
+fromMaybe :: (Maybe a) -> (MaybeG a)
+fromMaybe Nothing = LEFT (CONS "Nothing" UNIT)
+fromMaybe (Just a) = RIGHT (CONS "Just" a)
+
+toMaybe :: (MaybeG a) -> (Maybe a)
+toMaybe (LEFT _) = Nothing
+toMaybe (RIGHT (CONS _ a)) = Just a
+
+instance serialize (Maybe a) | serialize a & unitDecidable a where // 'isUnit a' is neccessary since we get 'CONS "Just" a',
+  write l c = write (fromMaybe l) c              // and serialize (CONS a) uses isUnit on that 'a' 
+  read r = case read r of                        // Before we had the constraint here, but now it is moved to the serialize class
+    Nothing -> Nothing
+    Just (s,r) -> Just (toMaybe s, r)