Commit dd62736c authored by Job Cuppen's avatar Job Cuppen

done

parent bc778515
......@@ -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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment